Mercurial > repos > tabletprog
view modules/sdl.tp @ 314:d4df33596e7d
Make modules in earlier module directories take precedence over ones in later directories
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Sat, 14 Mar 2015 12:10:40 -0700 |
parents | 2b045d5b673b |
children | 4c669942c30d |
line wrap: on
line source
{ _helper <- #{ llMessage: createWindow withVars: { title <- string ptr x <- obj_int32 ptr y <- obj_int32 ptr w <- obj_int32 ptr h <- obj_int32 ptr flags <- obj_uint32 ptr makeWindow <- lambda ptr windowOpaque <- cpointer ptr win <- object ptr } andCode: :title x y w h flags makeWindow { windowOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 windowOpaque val!: (SDL_CreateWindow: (title data) (x num) (y num) (w num) (h num) (flags num)) if: (windowOpaque val) { win <- ccall: makeWindow 1 (windowOpaque castTo: (object ptr)) mcall: value 2 option win } else: { mcall: none 1 option } } llMessage: createRenderer withVars: { window <- cpointer ptr index <- obj_int32 ptr flags <- obj_uint32 ptr rendOpaque <- cpointer ptr rend <- object ptr makeRender <- lambda ptr } andCode: :window index flags makeRender { rendOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 rendOpaque val!: (SDL_CreateRenderer: (window val) (index num) (flags num)) if: (rendOpaque val) { rend <- ccall: makeRender 1 (rendOpaque castTo: (object ptr)) mcall: value 2 option rend } else: { mcall: none 1 option } } llMessage: loadBMP withVars: { filename <- string ptr makeSurface <- lambda ptr surfOpaque <- cpointer ptr surf <- object ptr } andCode: :filename makeSurface{ surfOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 surfOpaque val!: (SDL_LoadBMP: (filename data)) if: (surfOpaque val) { surf <- ccall: makeSurface 1 (surfOpaque castTo: (object ptr)) mcall: value 2 option surf } else: { mcall: none 1 option } } llMessage: createTextureFromSurface withVars: { rendOpaque <- cpointer ptr surfOpaque <- cpointer ptr makeTexture <- lambda ptr texOpaque <- cpointer ptr tex <- object ptr } andCode: :rendOpaque surfOpaque makeTexture { texOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 texOpaque val!: (SDL_CreateTextureFromSurface: (rendOpaque val) (surfOpaque val)) if: (texOpaque val) { tex <- ccall: makeTexture 2 (rendOpaque castTo: (object ptr)) (texOpaque castTo: (object ptr)) mcall: value 2 option tex } else: { mcall: none 1 option } } llMessage: pollEvent withVars: { constructor <- lambda ptr event <- SDL_Event eventPtr <- cpointer ptr eventType <- obj_uint32 ptr timeStampO <- obj_uint32 ptr } andCode: :constructor { if: (SDL_PollEvent: (addr_of: event)) { eventType <- make_object: (addr_of: obj_uint32_meta) NULL 0 timeStampO <- make_object: (addr_of: obj_uint32_meta) NULL 0 eventType num!: ((addr_of: event) type) timeStampO num!: ((addr_of: ((addr_of: event) common)) timestamp) eventPtr <- make_object: (addr_of: cpointer_meta) NULL 0 eventPtr val!: (addr_of: event) mcall: value 2 option (ccall: constructor 3 (eventType castTo: (object ptr)) ( timeStampO castTo: (object ptr)) (eventPtr castTo: (object ptr))) } else: { mcall: none 1 option } } llMessage: populateWindowEvent withVars: { eventPtr <- cpointer ptr empty <- object ptr winEvent <- SDL_WindowEvent ptr ou32 <- obj_uint32 ptr ou8 <- obj_uint8 ptr oi32 <- obj_int32 ptr } andCode: :eventPtr empty { winEvent <- eventPtr val ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0 ou32 num!: (winEvent windowID) mcall: windowID! 2 empty ou32 ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0 ou8 num!: (winEvent event) mcall: event! 2 empty ou8 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0 oi32 num!: (winEvent data1) mcall: data1! 2 empty oi32 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0 oi32 num!: (winEvent data2) mcall: data2! 2 empty oi32 empty } llMessage: populateKeyEvent withVars: { eventPtr <- cpointer ptr empty <- object ptr keyEvent <- SDL_KeyboardEvent ptr ou32 <- obj_uint32 ptr ou16 <- obj_uint32 ptr ou8 <- obj_uint8 ptr } andCode: :eventPtr empty { keyEvent <- eventPtr val ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0 ou32 num!: (keyEvent windowID) mcall: windowID! 2 empty ou32 if: (keyEvent state) = SDL_PRESSED { mcall: pressed?! 2 empty true } else: { mcall: pressed?! 2 empty false } ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0 ou8 num!: (keyEvent repeat) mcall: repeat! 2 empty ou8 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0 ou32 num!: ((addr_of: (keyEvent keysym)) scancode) mcall: scanCode! 2 empty ou32 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0 ou32 num!: ((addr_of: (keyEvent keysym)) sym) mcall: keyCode! 2 empty ou32 ou16 <- make_object: (addr_of: obj_uint16_meta) NULL 0 ou16 num!: ((addr_of: (keyEvent keysym)) mod) mcall: mod! 2 empty ou16 empty } llMessage: populateMouseButtonEvent withVars: { eventPtr <- cpointer ptr empty <- object ptr mouseButEvent <- SDL_MouseButtonEvent ptr ou32 <- obj_uint32 ptr ou8 <- obj_uint8 ptr oi32 <- obj_int32 ptr } andCode: :eventPtr empty { mouseButEvent <- eventPtr val ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0 ou32 num!: (mouseButEvent windowID) mcall: windowID! 2 empty ou32 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0 ou32 num!: (mouseButEvent which) mcall: mouseID! 2 empty ou32 ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0 ou8 num!: (mouseButEvent button) mcall: button! 2 empty ou8 if: (mouseButEvent state) = SDL_PRESSED { mcall: pressed?! 2 empty true } else: { mcall: pressed?! 2 empty false } ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0 ou8 num!: (mouseButEvent clicks) mcall: clicks! 2 empty ou8 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0 oi32 num!: (mouseButEvent x) mcall: x! 2 empty oi32 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0 oi32 num!: (mouseButEvent y) mcall: y! 2 empty oi32 empty } llMessage: populateMouseMotionEvent withVars: { eventPtr <- cpointer ptr empty <- object ptr mouseMotEvent <- SDL_MouseMotionEvent ptr ou32 <- obj_uint32 ptr oi32 <- obj_int32 ptr } andCode: :eventPtr empty { mouseMotEvent <- eventPtr val ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0 ou32 num!: (mouseMotEvent windowID) mcall: windowID! 2 empty ou32 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0 ou32 num!: (mouseMotEvent which) mcall: mouseID! 2 empty ou32 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0 ou32 num!: (mouseMotEvent state) mcall: buttonState! 2 empty ou32 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0 oi32 num!: (mouseMotEvent x) mcall: x! 2 empty oi32 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0 oi32 num!: (mouseMotEvent y) mcall: y! 2 empty oi32 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0 oi32 num!: (mouseMotEvent xrel) mcall: xRel! 2 empty oi32 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0 oi32 num!: (mouseMotEvent yrel) mcall: yRel! 2 empty oi32 empty } } _constant <- macro: :name cname { quote: (llMessage: name withVars: { uintret <- obj_uint32 ptr } andCode: { uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0 uintret num!: cname uintret }) } _subsystems <- #{ _constant: timer SDL_INIT_TIMER _constant: audio SDL_INIT_AUDIO _constant: video SDL_INIT_VIDEO _constant: joystick SDL_INIT_JOYSTICK _constant: haptic SDL_INIT_HAPTIC _constant: gameController SDL_INIT_GAMECONTROLLER _constant: events SDL_INIT_EVENTS _constant: everything SDL_INIT_EVERYTHING } _windowOpts <- #{ _constant: fullscreen SDL_WINDOW_FULLSCREEN _constant: fullscreenDesktop SDL_WINDOW_FULLSCREEN_DESKTOP _constant: opengl SDL_WINDOW_OPENGL _constant: hidden SDL_WINDOW_HIDDEN _constant: borderless SDL_WINDOW_BORDERLESS _constant: minimized SDL_WINDOW_MINIMIZED _constant: maximized SDL_WINDOW_MAXIMIZED _constant: inputGrabbed SDL_WINDOW_INPUT_GRABBED _constant: allowHighDPI SDL_WINDOW_ALLOW_HIGHDPI } _renderOpts <- #{ _constant: software SDL_RENDERER_SOFTWARE _constant: accelerated SDL_RENDERER_ACCELERATED _constant: presentVSYNC SDL_RENDERER_PRESENTVSYNC _constant: targetTexture SDL_RENDERER_TARGETTEXTURE } _events <- #{ _constant: quit SDL_QUIT _constant: window SDL_WINDOWEVENT _constant: sysWM SDL_SYSWMEVENT _constant: keyDown SDL_KEYDOWN _constant: keyUp SDL_KEYUP _constant: textEditing SDL_TEXTEDITING _constant: textInput SDL_TEXTINPUT _constant: mouseMotion SDL_MOUSEMOTION _constant: mouseDown SDL_MOUSEBUTTONDOWN _constant: mouseUp SDL_MOUSEBUTTONUP _constant: mouseWheel SDL_MOUSEWHEEL _constant: joyAxis SDL_JOYAXISMOTION _constant: joyBall SDL_JOYBALLMOTION _constant: joyHat SDL_JOYHATMOTION _constant: joyDown SDL_JOYBUTTONDOWN _constant: joyUp SDL_JOYBUTTONUP _constant: joyDeviceAdded SDL_JOYDEVICEADDED _constant: joyDeviceRemoved SDL_JOYDEVICEREMOVED _constant: controllerAxis SDL_CONTROLLERAXISMOTION _constant: controllerDown SDL_CONTROLLERBUTTONDOWN _constant: controllerUp SDL_CONTROLLERBUTTONUP _constant: controllerDeviceAdded SDL_CONTROLLERDEVICEADDED _constant: controllerDeviceRemoved SDL_CONTROLLERDEVICEREMOVED _constant: controllerDeviceRemapped SDL_CONTROLLERDEVICEREMAPPED _constant: dropFile SDL_DROPFILE //TODO: Add mobile/touch/gesture events } _eventConstructors <- dict hash _eventConstructors set: (_events window) :typ tstamp eventPtr { _helper populateWindowEvent: eventPtr #{ type <- typ timeStamp <- tstamp windowID <- 0u32 event <- 0u8 data1 <- 0 data2 <- 0 } } keyEvent <- :typ tstamp eventPtr { _helper populateKeyEvent: eventPtr #{ type <- typ timeStamp <- tstamp windowID <- 0u32 pressed? <- false repeat <- 0u8 scanCode <- 0 keyCode <- 0 mod <- 0u16 _constant: scanCodeMask SDLK_SCANCODE_MASK keyChar <- { if: (keyCode and (self scanCodeMask)) = 0 { keyCode utf8 } else: { "" } } } } _eventConstructors set: (_events keyDown) keyEvent _eventConstructors set: (_events keyUp) keyEvent mouseButtonEvent <- :typ tstamp eventPtr { _helper populateMouseButtonEvent: eventPtr #{ type <- typ timeStamp <- tstamp windowID <- 0u32 mouseID <- 0u32 button <- 0u8 pressed? <- false clicks <- 0u8 x <- 0 y <- 0 } } _eventConstructors set: (_events mouseDown) mouseButtonEvent _eventConstructors set: (_events mouseUp) mouseButtonEvent _eventConstructors set: (_events mouseMotion) :typ tstamp eventPtr { _helper populateMouseMotionEvent: eventPtr #{ type <- typ timeStamp <- tstamp windowID <- 0u32 mouseID <- 0u32 buttonState <- 0u32 x <- 0 y <- 0 xRel <- 0 yRel <- 0 } } /* _eventConstructors set: (_events mouseWheel) :type tstamp eventPtr { _helper populateMouseWheelEvent: eventPtr #{ type <- typ timeStamp <- tstamp windowID <- 0u32 mouseID <- 0u32 x <- 0 y <- 0 } } */ _makeTexture <- :rendptr texptr { #{ includeSystemHeader: "SDL.h" llProperty: renderer withType: (SDL_Renderer ptr) llProperty: texture withType: (SDL_Texture ptr) llMessage: opaque withVars: { ptr <- cpointer ptr } andCode: { ptr <- make_object: (addr_of: cpointer_meta) NULL 0 ptr val!: texture ptr } llMessage: _ptr_init withVars: { rendptr <- cpointer ptr texptr <- cpointer ptr } andCode: :rendptr texptr{ renderer <- rendptr val texture <- texptr val self } llMessage: copy withVars: { intret <- obj_int32 ptr } andCode: { intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: (SDL_RenderCopy: renderer texture NULL NULL) intret } llMessage: copyTo withVars: { dst <- object ptr dstOpaque <- cpointer ptr intret <- obj_int32 ptr } andCode: :dst { dstOpaque <- (mcall: _rectPointer 1 dst) castTo: (cpointer ptr) intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: (SDL_RenderCopy: renderer texture NULL (dstOpaque val)) intret } llMessage: copyRect:To withVars: { src <- object ptr dst <- object ptr srcOpaque <- cpointer ptr dstOpaque <- cpointer ptr intret <- obj_int32 ptr } andCode: :src :dst { srcOpaque <- (mcall: _rectPointer 1 src) castTo: (cpointer ptr) dstOpaque <- (mcall: _rectPointer 1 dst) castTo: (cpointer ptr) intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: (SDL_RenderCopy: renderer texture (srcOpaque val) (dstOpaque val)) intret } llMessage: copyTo:rotated withVars: { dst <- object ptr angle <- object ptr dstOpaque <- cpointer ptr anglef <- obj_float32 ptr intret <- obj_int32 ptr } andCode: :dst :angle { anglef <- (mcall: f32 1 angle) castTo: (obj_float32 ptr) dstOpaque <- (mcall: _rectPointer 1 dst) castTo: (cpointer ptr) intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: (SDL_RenderCopyEx: renderer texture NULL (dstOpaque val) (anglef num) NULL SDL_FLIP_NONE) intret } llMessage: destroy withVars: {} andCode: { SDL_DestroyTexture: texture true } } _ptr_init: rendptr texptr } _makeSurface <- :ptr { #{ includeSystemHeader: "SDL.h" llProperty: surface withType: (SDL_Surface ptr) llMessage: opaque withVars: { ptr <- cpointer ptr } andCode: { ptr <- make_object: (addr_of: cpointer_meta) NULL 0 ptr val!: surface ptr } llMessage: _ptr_init withVars: { ptr <- cpointer ptr } andCode: :ptr{ surface <- ptr val self } asTexture <- :renderer { _helper createTextureFromSurface: (renderer opaque) opaque _makeTexture } llMessage: free withVars: {} andCode: { SDL_FreeSurface: surface true } } _ptr_init: ptr } #{ includeSystemHeader: "SDL.h" includeSystemHeader: "stdlib.h" llMessage: init withVars: { flags <- obj_uint32 ptr intret <- obj_int32 ptr } andCode: :flags { intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: (SDL_Init: (flags num)) if: (intret num) { atexit: SDL_Quit } intret } llMessage: initSubSystem withVars: { flags <- obj_uint32 ptr intret <- obj_int32 ptr } andCode: :flags { intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: (SDL_InitSubSystem: (flags num)) intret } llMessage: quitSubSystem withVars: { flags <- obj_uint32 ptr } andCode: :flags { SDL_QuitSubSystem: (flags num) true } r:g:b:a <- :rc :gc :bc :ac { #{ r <- rc g <- gc b <- bc a <- ac } } r:g:b <- :r :g :b { r: r g: g b: b a: 255u8 } createWindow:pos:size:flags <- :title :x y :w h :flags{ _helper createWindow: title x y w h flags :ptr { print: (string: ptr) . "\n" #{ includeSystemHeader: "SDL.h" llProperty: window withType: (SDL_Window ptr) llMessage: opaque withVars: { op <- cpointer ptr } andCode: { op <- make_object: (addr_of: cpointer_meta) NULL 0 op val!: window op } llMessage: _ptr_init withVars: { ptr <- cpointer ptr } andCode: :ptr { window <- ptr val self } renderOpts <- { _renderOpts } createRenderer:flags <- :index :flags { _helper createRenderer: (self opaque) index flags :ptr { #{ includeSystemHeader: "SDL.h" llProperty: renderer withType: (SDL_Renderer ptr) llMessage: opaque withVars: { op <- cpointer ptr } andCode: { op <- make_object: (addr_of: cpointer_meta) NULL 0 op val!: renderer op } llMessage: _ptr_init withVars: { ptr <- cpointer ptr } andCode: :ptr { renderer <- ptr val self } llMessage: drawColor! withVars: { color <- object ptr rc <- obj_uint8 ptr gc <- obj_uint8 ptr bc <- obj_uint8 ptr ac <- obj_uint8 ptr intret <- obj_int32 ptr } andCode: :color { intret <- make_object: (addr_of: obj_int32_meta) NULL 0 rc <- (mcall: r 1 color) castTo: (obj_uint8 ptr) gc <- (mcall: g 1 color) castTo: (obj_uint8 ptr) bc <- (mcall: b 1 color) castTo: (obj_uint8 ptr) ac <- (mcall: a 1 color) castTo: (obj_uint8 ptr) intret num!: (SDL_SetRenderDrawColor: renderer (rc num) (gc num) (bc num) (ac num)) intret } llMessage: clear withVars: { intret <- obj_int32 ptr } andCode: { intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: (SDL_RenderClear: renderer) intret } llMessage: present withVars: {} andCode: { SDL_RenderPresent: renderer true } llMessage: destroy withVars: {} andCode: { SDL_DestroyRenderer: renderer true } } _ptr_init: ptr } } llMessage: destroy withVars: { } andCode: { SDL_DestroyWindow: window true } } _ptr_init: ptr } } loadBMP <- :filename { _helper loadBMP: filename _makeSurface } llMessage: delay withVars: { ms <- obj_uint32 ptr } andCode: :ms { SDL_Delay: (ms num) true } llMessage: clearError withVars: {} andCode: { SDL_ClearError: true } rect:size <- :x y :w h { getter <- macro: :propName { quote: (llMessage: propName withVars: { intret <- obj_int32 ptr } andCode: { intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: ((addr_of: rect) propName) intret }) } setter <- macro: :propName { quote: (llMessage: propName withVars: { v <- obj_int32 ptr } andCode: :v { (addr_of: rect) propName: (v num) self }) } (((#{ llProperty: rect withType: SDL_Rect getter: x setter: x! getter: y setter: y! getter: w setter: w! getter: h setter: h! llMessage: _rectPointer withVars: { retptr <- cpointer ptr } andCode: { retptr <- make_object: (addr_of: cpointer_meta) NULL 0 retptr val!: (addr_of: (self rect)) retptr } } x!: x) y!: y) w!: w) h!: h } llMessage: getError withVars: { str <- string ptr rawstr <- const: (char ptr) } andCode: { rawstr <- SDL_GetError: str <- make_object: (addr_of: string_meta) NULL 0 str bytes!: (strlen: rawstr) str len!: (str bytes) str data!: (GC_MALLOC: (str bytes) + 1) memcpy: (str data) rawstr (str bytes) + 1 str } pollEvent <- { _helper pollEvent: :typ tstamp eventPtr { _eventConstructors ifget: typ :handler { handler: typ tstamp eventPtr } else: { //fallback event #{ type <- typ timeStamp <- tstamp } } } } subsystems <- { _subsystems } windowOpts <- { _windowOpts } eventTypes <- { _events } } }