indexbase 0

Typedef dword uint32
Typedef word  uint16
Typedef byte  uint8
Typedef short Sint16

% SDL_INIT_TIMER       = 0x00000001
% SDL_INIT_AUDIO       = 0x00000010
% SDL_INIT_VIDEO       = 0x00000020
% SDL_INIT_CDROM       = 0x00000100
% SDL_INIT_JOYSTICK    = 0x00000200
% SDL_INIT_NOPARACHUTE = 0x00100000
% SDL_INIT_EVENTTHREAD = 0x01000000	
% SDL_INIT_EVERYTHING  = 0x0000FFFF

% SDL_KEYDOWN    = 2
% SDL_KEYUP      = 3
% SDL_PEEKEVENT  = 1
% SDL_xQUIT 	 = 12		
% SDL_QUERY	 = -1
% SDL_IGNORE	 = 0
% SDL_DISABLE	 = 0
% SDL_ENABLE	 = 1

% WM_QUIT        = 18
% WM_CHAR        = 258
% WM_KEYDOWN     = 256
% WM_KEYUP       = 257
% WM_MOUSEMOVE   = 512
% WM_MBUTTONDOWN = 519
% WM_LBUTTONDOWN = 513
% WM_RBUTTONDOWN = 516
% WM_LBUTTONUP   = 514
% WM_RBUTTONUP   = 517
% WM_MBUTTONUP   = 520
% PM_REMOVE      = 1
% GENERIC_WRITE  = 0x40000000
% GENERIC_READ   = 0x80000000
% FILE_SHARE_READ  = 1
% FILE_SHARE_WRITE = 2
% OPEN_ALWAYS      = 4

% SDLK_BACKSPACE = 8
% SDLK_TAB	 = 9
% SDLK_RETURN	 = 13
% SDLK_ESCAPE	 = 27
% SDLK_SPACE	 = 32
% SDLK_UP	 = 273
% SDLK_DOWN	 = 274
% SDLK_RIGHT	 = 275
% SDLK_LEFT	 = 276
% SDLK_INSERT	 = 277
% SDLK_HOME	 = 278
% SDLK_END	 = 279
% SDLK_PAGEUP	 = 280
% SDLK_PAGEDOWN	 = 281
% SDLK_RCTRL	 = 305
% SDLK_LCTRL	 = 306

% SDL_MOUSEMOTION       =4	
% SDL_MOUSEBUTTONDOWN   =5	
% SDL_MOUSEBUTTONUP     =6
% SDL_ALPHA_OPAQUE      =255
% SDL_ALPHA_TRANSPARENT =0

% SDL_SWSURFACE	 = 0x00000000
% SDL_HWSURFACE	 = 0x00000001
% SDL_ASYNCBLIT	 = 0x00000004
% SDL_ANYFORMAT	 = 0x10000000
% SDL_HWPALETTE	 = 0x20000000
% SDL_DOUBLEBUF	 = 0x40000000
% SDL_FULLSCREEN = 0x80000000
% SDL_OPENGL     = 0x00000002 
% SDL_OPENGLBLIT = 0x0000000A
% SDL_RESIZABLE	 = 0x00000010
% SDL_NOFRAME	 = 0x00000020
% SDL_HWACCEL	 = 0x00000100
% SDL_SRCCOLORKEY= 0x00001000
% SDL_RLEACCELOK = 0x00002000
% SDL_RLEACCEL	 = 0x00004000
% SDL_SRCALPHA	 = 0x00010000
% SDL_PREALLOC	 = 0x01000000

Type OVERLAPPED
  ternal     as Long
  ternalHigh as Long
  offset     as Long
  OffsetHigh as Long
  hEvent     as Long
End Type

Type POINTAPI
  x as long
  y as long
End Type

Type MSG
  hwnd    as sys
  message as long
  wParam  as sys
  lParam  as sys
  time    as long
  pt      as POINTAPI
End Type

Type SDL_Rect 
  word x, y
  word w, h
End Type

Type SDL_Color 
  byte r
  byte g
  byte b
  byte unused
End Type

Type SDL_Palette 
  word ncolors
  SDL_Color *colors
End Type

typedef struct SDL_PixelFormat {
  SDL_Palette *palette
  Uint8  BitsPerPixel
  Uint8  BytesPerPixel
  Uint8  Rloss
  Uint8  Gloss
  Uint8  Bloss
  Uint8  Aloss
  Uint8  Rshift
  Uint8  Gshift
  Uint8  Bshift
  Uint8  Ashift
  Uint32 Rmask
  Uint32 Gmask
  Uint32 Bmask
  Uint32 Amask
  Uint32 colorkey
  Uint8  alpha
} SDL_PixelFormat

typedef struct SDL_Surface {
  Uint32 flags				
  SDL_PixelFormat *format		
  int w, h				
  Uint16 pitch				
  void *pixels				
  int offset				
  void *private_hwdata                    
  SDL_Rect clip_rect			
  Uint32 unused1				
  Uint32 locked				
  void *SDL_BlitMap                       
  dword format_version                    
  int refcount				
} SDL_Surface

Declare QueryPerformanceCounter   Lib "kernel32.dll" (quad *c)  
Declare QueryPerformanceFrequency Lib "kernel32.dll" (quad *c)  

sys sdl,user,kern,winm,gdi
sdl  = LoadLibrary "sdl.dll"
gdi  = LoadLibrary "gdi32.dll"
kern = LoadLibrary "kernel32.dll"
user = LoadLibrary "user32.dll"
winm = LoadLibrary "winmm.dll"

Sub CallDll(sys DllAdr, string libName)
    Return GetProcAddress DllAdr, libName
End Sub

sys ExitProcess       = CallDll(kern,"ExitProcess")
sys ReadFile          = CallDll(kern,"ReadFile")
sys WriteFile         = CallDll(kern,"WriteFile")
sys CloseHandle       = CallDll(kern,"CloseHandle")
sys CreateFile        = CallDll(kern,"CreateFileA")
sys GetFileSize       = CallDll(kern,"GetFileSize")
sys Sleep             = CallDll(kern,"Sleep")
sys Beep              = CallDll(kern,"Beep")
sys GetDC             = CallDll(user,"GetDC")  
sys DispatchMessage   = CallDll(user,"DispatchMessageA")
sys TranslateMessage  = CallDll(user,"TranslateMessage")
sys PeekMessage       = CallDll(user,"PeekMessageA")
sys GetAsyncKeyState  = CallDll(user,"GetAsyncKeyState")
sys FindWindow        = CallDll(user,"FindWindowA")
sys SetWindowText     = CallDll(user,"SetWindowTextA")
sys PlayWav           = CallDll(winm,"PlaySoundA")
sys GetPoint          = CallDll(gdi,"GetPixel")

Bind sdl
(
  SDL_WM_SetCaption    SDL_WM_SetCaption 
  SDL_SetVideoMode     SDL_SetVideoMode 
  SDL_Init             SDL_Init 
  SDL_SetColorKey      SDL_SetColorKey 
  SDL_FreeSurface      SDL_FreeSurface 
  SDL_Flip             SDL_Flip 
  SDL_Delay            SDL_Delay 
  SDL_Quit             SDL_Quit 
  SDL_FillRect         SDL_FillRect  
  SDL_GetRGB           SDL_GetRGB  
  SDL_GetRGBA          SDL_GetRGBA  
  SDL_MapRGB           SDL_MapRGB
  SDL_GetTicks         SDL_GetTicks
  SDL_DisplayFormat    SDL_DisplayFormat 
  SDL_SetColors        SDL_SetColors  
  SDL_PollEvent        SDL_PollEvent 
  SDL_UpperBlit        SDL_UpperBlit 
  SDL_LoadBMP_RW       SDL_LoadBMP_RW 
  SDL_RWFromFile       SDL_RWFromFile
  SDL_ShowCursor       SDL_ShowCursor
  SDL_GetMouseState    SDL_GetMouseState 
  SDL_GetKeyState      SDL_GetKeyState 
  SDL_PumpEvents       SDL_PumpEvents
  SDL_SoftStretch      SDL_SoftStretch
  SDL_CreateRGBSurface SDL_CreateRGBSurface  
)

dword Width,Height,ColorKey,Screen,wExit,sys_fjs,sys_Frames,dot
sys MouseButton, xMouse, yMouse, hdc, hwnd, string sys_cap ="SDL_app"
quad sys_ct1,sys_ct2,sys_freq,sys_qc1,sys_qc2,sys_qf                                                               
double sys_interval               

sys BmpWidth  [512]
sys BmpHeight [512]
sys BmpHandle [512] 
sys TileWidth [512]
sys TileHeight[512]
sys TileHandle[512] 

Dim wm as MSG
Dim s1Rect as SDL_Rect   'drawimage source rect
Dim s2Rect as SDL_Rect   'drawimage destination rect
Dim s3Rect as SDL_Rect   'clscolor rect
Dim p1Rect as SDL_Rect   'point source rect
Dim p2Rect as SDL_Rect   'point destination rect
Dim *video as SDL_Surface
Dim *point as SDL_Surface

int seed = SDL_GetTicks
QueryPerformanceFrequency sys_qf   
QueryPerformanceCounter   sys_qc1

SDL_Init SDL_INIT_EVERYTHING

Sub FindWindowSDL()
    Hwnd= call FindWindow 0, *sys_cap
    hdc = call GetDC hwnd
End Sub

Sub SetCaption(string captext)
    'sys_cap = strptr captext
    SDL_WM_SetCaption strptr captext, 0
End Sub

Function HiWord (sys hi) as sys
    shr hi,16
    Return hi
End Function

Function LoWord (sys lo) as sys
    and lo,0xFFFF 
    Return lo
End Function

Function LoadFile(string File, byref dest as any) as sys  
sys Handle, count, wc
Handle = call CreateFile File,GENERIC_READ,FILE_SHARE_READ,BYVAL 0,OPEN_ALWAYS,0,0 
count  = call GetFileSize Handle, Byval 0  
call ReadFile Handle,dest,count,&wc,Byval 0
call CloseHandle Handle
Return wc
End Function

Function SaveFile(string File,byref dest as any,sys count) as sys   
sys Handle,wc
Handle = call CreateFile File,GENERIC_WRITE,FILE_SHARE_WRITE,BYVAL 0,OPEN_ALWAYS,0,0 
call WriteFile Handle,dest,count,&wc,Byval 0
call CloseHandle Handle
Return wc
End Function

Sub SetDisPlay(sys w, h, mode)
iF mode >=1
   &Video= SDL_SetVideoMode w,h,32,SDL_HWSURFACE | SDL_DOUBLEBUF 	  
   mov screen,eax 
Else 
   &Video= SDL_SetVideoMode w,h,32,SDL_HWSURFACE | SDL_DOUBLEBUF | SDL_FULLSCREEN 
   mov screen,eax
End iF
Width = w
Height= h
FindWindowSDL
 &point = SDL_CreateRGBSurface(SDL_HWSURFACE, 100,100, 32, 0,0,0,0)
mov dot,eax   
End Sub

Sub Events()
sys vRes
vRes = call PeekMessage &wm,0,0,0,Pm_Remove 
iF vRes >0 
   iF wm.message = WM_QUIT Then wExit=1 
   iF wm.message = WM_MOUSEMOVE
      xMouse = LoWord wm.lParam
      yMouse = HiWord wm.lParam
   End iF
   iF wm.message = WM_LBUTTONDOWN
      MouseButton =1
   ElseiF wm.message = WM_LBUTTONUP
      MouseButton =0  
   ElseiF wm.message = WM_RBUTTONDOWN
      MouseButton =2
   ElseiF wm.message = WM_RBUTTONUP
      MouseButton =0
   ElseiF wm.message = WM_MBUTTONDOWN
      MouseButton =4
   ElseiF wm.message = WM_MBUTTONUP
      MouseButton =0
   End iF 
   call TranslateMessage &wm
   call DispatchMessage  &wm
End iF
End Sub

Function RGB(sys red,green,blue) as sys
    green *=256: red *=65536
    Return blue+green+red              
End Function

Function MouseZone(sys x1,y1,x2,y2) as sys
iF xMouse >=x1 and yMouse >=y1 and xMouse <=x2 and yMouse <=y2
   Return 1
End iF   
End Function

Sub ShowMouse(int ms)
    SDL_ShowCursor ms
End Sub 

Sub GetPixel(sys x,y) 
    Return call GetPoint hdc, x, y
End Sub    
    
Sub SetColorKey(sys r1,g1,b1)
    ColorKey = RGB(r1,g1,b1)
End Sub

Sub ClsColor(sys red,green,blue)
    s3Rect <= 0,0,width, height 
    SDL_FillRect Screen, &s3Rect, RGB(red,green,blue) 
End Sub

Function Flip() as word
    Events
    SDL_Flip Screen
End Function

Function LoadImage(string bmpfile, sys fx) as sys
Dim *a as SDL_Surface
iF fx <=0 Then fx=1
static sys id: iF id <512 Then inc id  
SDL_RWFromFile bmpfile,"rb" 
@a=SDL_LoadBMP_RW eax,1 
BmpHandle[id] = eax
BmpWidth [id] = a.w/fx
BmpHeight[id] = a.h
SDL_SetColorKey BmpHandle[id], SDL_SRCCOLORKEY, ColorKey 
Return id
End Function

Sub DrawImage(sys id, short x,y, sys f)
short bw=BmpWidth[id]
short bh=BmpHeight[id]
s1Rect <= bw*f,0,bw,bh
s2Rect <= x,y,bw,bh
SDL_UpperBlit BmpHandle[id], &s1Rect, screen, &s2Rect
End Sub

Function LoadTiles(string bmpfile, sys fx, fy) as sys
Dim *a as SDL_Surface
iF fx <=0 Then fx=1: iF fy <=0 Then fy=1
static sys id: iF id <512 Then inc id  
SDL_RWFromFile bmpfile,"rb" 
@a=SDL_LoadBMP_RW eax,1 
TileHandle[id] = eax
TileWidth [id] = a.w/fx
TileHeight[id] = a.h/fy
SDL_SetColorKey TileHandle[id], SDL_SRCCOLORKEY, ColorKey 
Return id
End Function

Sub DrawTiles(sys id, short x,y, sys ax,ay)
int tw=TileWidth[id]
int th=TileHeight[id]
s1Rect <= tw*ax,th*ay,tw,th
s2Rect <= x,y,tw,th
SDL_UpperBlit TileHandle[id], &s1Rect, screen, &s2Rect
End Sub

Sub DrawText(sys id,tx,ty, string txt) 
sys sx, rx
For sx=1 To Len(txt)
rx = Asc(txt, sx)
iF rx >=32 and rx <=127 
   rx = rx -32
   DrawImage id,tx,ty,rx
iF rx=0 Then
   tx = tx + 16
Else
   tx = tx + BmpWidth[id]
End iF
End iF
Next 
End Sub

Sub SetFps(sys frame)    
QueryPerformanceFrequency sys_freq                                                                                          
sys_Interval = sys_freq/frame  
While (1)                                                                       
QueryPerformanceCounter sys_ct2                                                 
iF sys_ct2 >= sys_ct1 + sys_interval                                             
QueryPerformanceCounter sys_ct1                                              
Exit Sub            
End iF
Wend                                                                             
End Sub

Function ShowFps() as sys 
QueryPerformanceCounter sys_qc2
iF sys_qc2 - sys_qc1 > sys_qf             
sys_fjs = sys_Frames
sys_Frames =0
sys_qc1 += sys_qf                         
End iF
sys_Frames +=1
Return sys_fjs
End Function

Sub WaitKey(sys iKey)
    sys xKey
    While xKey=0  
    iF wExit=1 Then Return 1
    xKey = call GetAsyncKeyState iKey
    Flip
    call Sleep 10
    Wend
End Sub    

Function Key(sys cKey) As short
    iF wExit=1 Then Return 1
    '#show Return call GetAsyncKeyState cKey 
    Return call GetAsyncKeyState cKey 
End Function

Sub WaitMouse()
While (1)
iF MouseButton >=1 and MouseButton <=4
   Return MouseButton
End iF
iF wExit=1 Then Return 1
Flip
call Sleep 10
Wend
End Sub

Sub Ends()
sys ix
For ix=0 To 512
iF BmpHandle[ix] >0 
   SDL_FreeSurface BmpHandle[ix]
   BmpHandle[ix]=0
End iF
Next
For ix=0 To 512
iF TileHandle[ix] >0 
   SDL_FreeSurface TileHandle[ix]
   TileHandle[ix]=0
End iF
Next
SDL_FreeSurface dot
SDL_Quit
End Sub

Sub Randomize()
    seed = SDL_GetTicks
End Sub

Function Rand(sys z1,z2) as sys
sys  rnd 
mov  eax,z2
sub  eax,z1
inc  eax
imul edx,seed,0x8088405
inc  edx
mov  seed,edx
mul  edx
add  edx,z1
mov  rnd,edx
Return rnd
End Function 

Function GetColorR(sys color) as sys
    Return color & 0xFF
End Function    

Function GetColorG(sys color) as sys
    Return (color >> 8) & 0xFF
End Function    

Function GetColorB(sys color) as sys
    Return (color >> 16) & 0xFF
End Function    

Sub SetPixel(int x,y, byte r,g,b)  
    p1Rect.x=0:p1Rect.y=0:p1Rect.w=2:p1Rect.h=2    
    p2Rect.x=x:p2Rect.y=y:p2Rect.w=2:p2Rect.h=2    
    SDL_FillRect  dot, &p1Rect, RGB(r, g, b)
    SDL_UpperBlit dot, &p1Rect, screen, &p2Rect
End Sub

Sub Ellipse(sys mx, my, a, b, r1,g1,b1)
sys x, mx1 ,mx2, my1, my2
sys aq, bq, idx, idy, r, rx, ry
SetPixel mx+a, my,r1,g1,b1
SetPixel mx-a, my,r1,g1,b1
mx1 = mx-a: my1 = my
mx2 = mx+a: my2 = my
aq  = a*a : bq  = b*b      
idx = aq*2: idy = bq*2               
r   = a*bq: rx  = r*2                
ry  = 0   : x   = a                      
While x >0
iF r >0
   my1 +=1: my2 -=1: ry += idx 
   r -= ry             
End iF
iF r <=0
   x -=1: mx1 +=1: mx2 -=1
   rx -= idy: r += rx
End iF
SetPixel mx1, my1, r1,g1,b1
SetPixel mx1, my2, r1,g1,b1
SetPixel mx2, my1, r1,g1,b1
SetPixel mx2, my2, r1,g1,b1
Wend  
End Sub

Sub Line(int x1, y1, x2, y2, byte r,g,b)
sys i,deltaX,deltaY,pixel,d,dinc1,dinc2
int x, y, sys xinc1, xinc2, yinc1, yinc2 
deltaX = Abs (x2-x1)
deltaY = Abs (y2-y1)
iF deltaX >= deltaY
 pixel = deltaX +1
 d = (2* deltaY) - deltaX
 dinc1 = deltaY *2
 dinc2 = (deltaY - deltaX) *2
 xinc1 = 1
 xinc2 = 1
 yinc1 = 0
 yinc2 = 1
Else
 pixel = deltaY +1
 d = (2 * deltaX)-deltaY
 dinc1 = deltaX *2                
 dinc2 = (deltaX-deltaY) *2      
 xinc1 = 0
 xinc2 = 1
 yinc1 = 1
 yinc2 = 1
End iF
iF x1 > x2 
 xinc1 = - xinc1
 xinc2 = - xinc2
End iF
iF y1 > y2 
 yinc1 = - yinc1
 yinc2 = - yinc2
End iF
x = x1
y = y1
For i =1 To pixel 
SetPixel x, y, r,g,b
iF d < 0 
 d = d + dinc1
 x = x + xinc1
 y = y + yinc1
Else
 d = d + dinc2
 x = x + xinc2
 y = y + yinc2
End iF
Next
End Sub    

Sub FillCircle(int xc,yc,r, byte r1,g1,b1)
single iterations =2*pi*r
single theta
sys i, x, y
   For  i=0 To i<=iterations
      theta = 2*pi*i / iterations
      x = xc + r * cos(theta)
      y = yc + r * sin(theta)
      Line xc, yc, x, y, r1,g1,b1
   Next
End Sub

Sub Rectangle(int x, y, w, h, byte r,g,b)
    Line x, y, x+w, y,  r,g,b
    Line x,y+h,x+w,y+h, r,g,b
    Line x, y, x, y+h,  r,g,b
    Line x+w,y,x+w,y+h, r,g,b
End Sub

Sub Paint(sys x1,y1,x2,y2, r,g,b)
sys x,y
For x=0 To x2
  For y=0 To y2
    SetPixel x1+x,y1+y,r,g,b
  Next
Next
End Sub
