/* New Function Librarys for OxygenBasic by P. Wirbelauer o3.o6.2o12 */
indexbase 0

Type DEVMODE
  zstring dmDeviceName[32]    
  dmSpecVersion   as word    
  dmDriverVersion as word    
  dmSize          as word    
  dmDriverExtra   as word    
  dmFields        as long    
  dmOrientation   as word   
  dmPaperSize     as word   
  dmPaperLength   as word   
  dmPaperWidth    as word   
  dmScale         as word   
  dmCopies        as word   
  dmDefaultSource as word   
  dmPrintQuality  as word   
  dmColor         as word   
  dmDuplex        as word   
  dmYResolution   as word   
  dmTTOption      as word   
  dmCollate       as word   
  zstring dmFormName[32]    
  dmUnusedPadding as word   
  dmBitsPerPel    as long   
  dmPelsWidth     as long   
  dmPelsHeight    as long   
  dmDisplayFlags  as long   
  dmDisplayFrequency   as long  
  dmDisplayOrientation as long
End Type                     

Type WNDCLASS
  Style         as long
  lpfnwndproc   as sys
  cbClsextra    as long
  cbWndExtra    as long
  hInstance     as sys
  hIcon         as sys
  hCursor       as sys
  hbrBackground as sys
  lpszMenuName  as sys
  lpszClassName as sys
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 RECT
  Left   as Long
  Top    as Long
  Right  as Long
  Bottom as Long
End Type

Type BITMAP
  bmType       as Long
  bmWidth      as Long
  bmHeight     as Long
  bmWidthBytes as Long
  bmPlanes     as short
  bmBitsPixel  as short
  bmBits       as sys
End Type

% SW_SHOW        = 5
% CS_VREDRAW     = 1
% CS_HREDRAW     = 2
% IDI_WINLOGO    = 32517
% IDC_ARROW      = 32512
% WM_CREATE      = 1
% WM_DESTROY     = 2
% WM_PAINT       = 15
% WM_QUIT        = 18
% WM_SIZE        = 5
% WM_MOVE        = 3
% 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
% WS_OVERLAPPED  = 0x80000      
% WS_POPUP       = 0x80000000
% WS_MINIMIZEBOX = 0x20000
% PM_REMOVE      = 1
% WHITE_BRUSH    = 0
% BLACK_BRUSH    = 4
% DM_PELSWIDTH   = 0x80000
% DM_PELSHEIGHT  = 0x100000
% DM_BITSPERPEL  = 0x40000
% DI_NORMAL      = 3 
% GENERIC_WRITE  = 0x40000000
% GENERIC_READ   = 0x80000000
% FILE_SHARE_READ  = 1
% FILE_SHARE_WRITE = 2
% OPEN_ALWAYS      = 4

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

Dim wm   as MSG
Dim wc   as WNDCLASS 
Dim rc   as Rect
Dim dvm  as DEVMODE
Dim info as BITMAP
Dim icoHnd(512) as sys
Dim BmpHdc(512) as sys
Dim BmpHnd(512) as sys
Dim BmpWidth (512) as sys
Dim BmpHeight(512) as sys
Dim Reso(3) as sys 

sys MouseButton,xMouse,yMouse,wExit,seed,AscKey,sys_fjs,sys_Frames
sys winmm,kernel,user,gdi,hwnd,hdc,bHdc,bHnd,ScreenWidth,ScreenHeight,sys_color
Quad sys_ct1,sys_ct2,sys_freq,sys_qc1,sys_qc2,sys_qf                                                               
Double sys_interval               

kernel= LoadLibrary "kernel32.dll"
user  = LoadLibrary "user32.dll"
gdi   = LoadLibrary "gdi32.dll"
winmm = LoadLibrary "winmm.dll"

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


sys GetModuleHandle       = CallDll(kernel,"GetModuleHandleA")
sys ExitProcess           = CallDll(kernel,"ExitProcess")
sys Sleep                 = CallDll(kernel,"Sleep")  
sys GetTickCount          = CallDll(kernel,"GetTickCount")
sys ReadFile              = CallDll(kernel,"ReadFile")
sys WriteFile             = CallDll(kernel,"WriteFile")
sys CloseHandle           = CallDll(kernel,"CloseHandle")
sys CreateFile            = CallDll(kernel,"CreateFileA")
sys GetFileSize           = CallDll(kernel,"GetFileSize") 
sys LoadCursor            = CallDll(user,"LoadCursorA")
sys LoadIconA             = CallDll(user,"LoadIconA")
sys RegisterClass         = CallDll(user,"RegisterClassA")
sys CreateWindowEx        = CallDll(user,"CreateWindowExA")
sys ShowWindow            = CallDll(user,"ShowWindow")
sys GetDC                 = CallDll(user,"GetDC")  
sys InvalidateRect        = CallDll(user,"InvalidateRect")
sys ValidateRect          = CallDll(user,"ValidateRect")
sys DispatchMessage       = CallDll(user,"DispatchMessageA")
sys TranslateMessage      = CallDll(user,"TranslateMessage")
sys PeekMessage           = CallDll(user,"PeekMessageA")
sys PostQuitMessage       = CallDll(user,"PostQuitMessage")
sys DefWindowProc         = CallDll(user,"DefWindowProcA")
sys SetWindowText         = CallDll(user,"SetWindowTextA")
sys UpDateWindow          = CallDll(user,"UpdateWindow")
sys GetAsyncKeyState      = CallDll(user,"GetAsyncKeyState")
sys ReleaseDC             = CallDll(user,"ReleaseDC")
sys ChangeDisplaySettings = CallDll(user,"ChangeDisplaySettingsA")
sys EnumDisplaySettings   = CallDll(user,"EnumDisplaySettingsA") 
sys DestroyWindow         = CallDll(user,"DestroyWindow")
sys LoadImage             = CallDll(user,"LoadImageA")
sys SetCursorPos          = CallDll(user,"SetCursorPos")
sys ShowCursor            = CallDll(user,"ShowCursor")
sys GetClientRect         = CallDll(user,"GetClientRect")
sys MoveWindow            = CallDll(user,"MoveWindow")
sys GetWindowRect         = CallDll(user,"GetWindowRect")
sys DrawIconEx            = CallDll(user,"DrawIconEx")
sys GetStockObject        = CallDll(gdi,"GetStockObject")
sys SelectObject          = CallDll(gdi,"SelectObject")
sys DeleteObject          = CallDll(gdi,"DeleteObject")
sys CreateFont            = CallDll(gdi,"CreateFontA")
sys TextOut               = CallDll(gdi,"TextOutA")
sys SetTextColor          = CallDll(gdi,"SetTextColor")
sys SetBkMode             = CallDll(gdi,"SetBkMode")
sys Poke                  = CallDll(gdi,"SetPixelV")
sys Peek                  = CallDll(gdi,"GetPixel")
sys CreateSolidBrush      = CallDll(gdi,"CreateSolidBrush")
sys Rectangle             = CallDll(gdi,"Rectangle") 
sys DeleteDC              = CallDll(gdi,"DeleteDC")
sys BitBlt                = CallDll(gdi,"BitBlt")
sys CreateCompatibleDC    = CallDll(gdi,"CreateCompatibleDC") 
sys CreateCompatibleBitmap= CallDll(gdi,"CreateCompatibleBitmap")
sys GdiTransparentBlt     = CallDll(gdi,"GdiTransparentBlt")
sys GetObject             = CallDll(gdi,"GetObjectA")
sys Ellipse               = CallDll(gdi,"Ellipse")
sys SetTextCharacterExtra = CallDll(gdi,"SetTextCharacterExtra")
sys MoveToEx              = CallDll(gdi,"MoveToEx")
sys LineTo                = CallDll(gdi,"LineTo")
sys CreatePen             = CallDll(gdi,"CreatePen")  
sys PlayWav               = CallDll(winmm,"PlaySoundA")

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

Sub SaveFile(string File,byref dest as any,sys count)   
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
End Sub

Function SetDisplay(sys width, height, bpp) as sys
sys i,dev 
Do
dev = call EnumDisplaySettings 0,i,@dvm   
iF dev =0 Then Exit Do
i +=1
End Do
Reso(0) = dvm.dmPelsWidth
Reso(1) = dvm.dmPelsHeight  
Reso(2) = dvm.dmBitsPerPel
dvm.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
dvm.dmPelsWidth  = width
dvm.dmPelsHeight = height
dvm.dmBitsPerPel = bpp
call ChangeDisplaySettings @dvm,4
Return eax
End Function

Sub RestoreDisplay()
dvm.dmPelsWidth  = Reso(0)
dvm.dmPelsHeight = Reso(1)
dvm.dmBitsPerPel = Reso(2)
call ChangeDisplaySettings 0,0   
End Sub

Function LoadBmp(string File, sys Frames) as sys
iF Frames <=0 Then Frames =1
static id as sys
iF id <512 Then id +=1
BmpHnd(id) = call LoadImage 0,File,0,0,0,16
BmpHdc(id) = call CreateCompatibleDC hdc
call SelectObject BmpHdc(id), BmpHnd(id)
call GetObject BmpHnd(id), sizeof info, &info
BmpWidth (id) = info.bmWidth /Frames 
BmpHeight(id) = info.bmHeight         
Return id
End Function        

Sub SetBmp(sys id, x1, y1, zx, zy, zF)
call GdiTransparentBlt bHdc,x1,y1,zx,zy,BmpHdc(id),BmpWidth(id)*zF,0,BmpWidth(id),BmpHeight(id),sys_color 
End Sub

Sub BmpText(sys id,tx,ty, string txt, sys zx,zy) 
sys sx, rx
For sx=1 To Len(txt)
rx = Asc(txt, sx)
iF rx >=32 and rx <=127 
rx = rx -32
SetBmp id,tx,ty,zx,zy,rx
tx = tx + zx
End iF
Next 
End Sub

Function LoadIcon(string file) as sys
Static id as sys
iF id < 512 Then id +=1
IcoHnd(id) = call LoadImage 0, file, 1, 0, 0, 16    
Return id
End Function

Sub SetIcon (sys idx, x, y, zx, zy, fx)
call DrawIconEx bHdc, x, y, IcoHnd(idx), zx, zy, fx, 0, DI_NORMAL
End Sub

Sub Ends()             
sys jx
iF Reso(0) >0 and Reso(1) >0 Then RestoreDisplay
For jx=0 To 512
iF BmpHdc(jx) >0 
   call DeleteObject BmpHnd(jx)
   call DeleteDC     BmpHdc(jx)
EndiF
Next
For jx=0 To 512
iF IcoHnd(jx) >0 
   call DeleteObject IcoHnd(jx)
EndiF
Next
call DestroyWindow hwnd  
call ReleaseDC hwnd,hdc
call DeleteObject bHnd
call DeleteDC     bHdc
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
   call TranslateMessage &wm
   call DispatchMessage  &wm
End iF
End Sub

Sub Flip()
Events
call BitBlt hdc,0,0,ScreenWidth,ScreenHeight,bHdc,0,0,0xCC0020
End Sub

Sub SetCaption(string txt)
call SetWindowText hwnd,txt
End Sub    

Sub ShowMouse(sys mouse)   
call ShowCursor mouse
End Sub                

Sub SetColorKey(sys red, green, blue)
sys_color= red+green*256+blue*65536  
End Sub

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 WaitKey(sys iKey)
int xKey
While xKey=0  
xKey = call GetAsyncKeyState iKey
iF wExit=1
   Return
End iF
Events
Flip
Wend
End Sub    

Function Key(sys cKey) As short
Events
iF wExit=1 
   Return -1
End iF
Return call GetAsyncKeyState cKey 
End Function

Sub SetFont(sys width, height, flag, string fontname)  
sys hFont
hFont = call CreateFont height,width,0,0,flag,0,0,0,0,0,0,0,0,fontname
call SelectObject bHdc, hFont
call SetBkMode bHdc,1
call DeleteObject hFont
End Sub

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

Sub ClsColor(sys r,g,b)
sys iBrush = call CreateSolidBrush RGB(r,g,b)
call SelectObject bHdc, iBrush
call Rectangle bHdc,0,0,ScreenWidth,ScreenHeight
call DeleteObject iBrush
End Sub

Sub SetText(sys x,y, string txt, sys r,g,b) 
call SetTextColor bHdc,RGB(r,g,b)
call TextOut bHdc,x,y,txt,Len(txt)
End Sub

Sub SetPixel(sys x,y, r,g,b)
call Poke bHdc,x,y,RGB(r,g,b)
End sub

Function GetPixel(sys x,y) as sys
Return call Peek bHdc,x,y
End Function

Function GetImagePixel(sys id,x,y) as sys
iF x>BmpWidth (id) Then Return 0
iF y>BmpHeight(id) Then Return 0
Return call Peek BmpHdc(id),x,y
End Function

Sub SetImagePixel(sys id,x,y, r,g,b)
iF x>BmpWidth (id) Then Return 0
iF y>BmpHeight(id) Then Return 0
call Poke BmpHdc(id),x,y,RGB(r,g,b)
End sub

Sub Oval(sys x,y,ra,rb, r,g,b)
sys iBrush
iBrush = call CreateSolidBrush RGB(r,g,b)
call SelectObject bHdc, iBrush
call Ellipse bHdc,x,y,ra+x,rb+y
call DeleteObject iBrush
End Sub

Sub Line(sys x,y,a,b,w, rc,gc,bc)
sys iPen,hPen
iPen = call CreatePen 0,w,RGB(rc,gc,bc)
call SelectObject bHdc, iPen
call MoveToEx bHdc,x,y,Byval 0
call LineTo bHdc,a,b
call DeleteObject iPen
hPen = call GetStockObject 19
call SelectObject bHdc, hPen
End Sub

Sub Randomize()
seed = GetTickCount
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 WndProc(byval hWnd as sys,byval wMsg as sys, byval wParam as sys,byval lparam as sys) as sys callback
iF wMsg = WM_CREATE
'
ElseiF wMsg = WM_MOVE 
Flip
call ValidateRect hwnd,0
ElseiF wMsg = WM_MOUSEMOVE
xMouse = LoWord(lParam)
yMouse = HiWord(lParam)
call InValidateRect hwnd,0,0
ElseiF wMsg = WM_LBUTTONDOWN
MouseButton =1
call InvalidateRect hWnd,0,0 
ElseiF wMsg = WM_LBUTTONUP
MouseButton =0  
call InvalidateRect hWnd,0,0 
ElseiF wMsg = WM_RBUTTONDOWN
MouseButton =2
call InvalidateRect hWnd,0,0 
ElseiF wMsg = WM_RBUTTONUP
MouseButton =0
call InvalidateRect hWnd,0,0
ElseiF wMsg = WM_MBUTTONDOWN
MouseButton =4
call InvalidateRect hWnd,0,0 
ElseiF wMsg = WM_MBUTTONUP
MouseButton =0
call InvalidateRect hWnd,0,0
ElseiF wMsg = WM_CHAR
AscKey = wParam
call InvalidateRect hWnd,0,0
ElseiF wMsg = WM_KEYUP
AscKey =0
call InvalidateRect hWnd,0,0
ElseiF wMsg = WM_DESTROY
call PostQuitMessage 0
Else
Return call DefWindowProc hWnd,wMsg,wParam,lParam
End iF
End Function

Function Screen(sys width, height, s) as sys
sys hInst, mode, w, h
iF s>=1 Then s= WS_OVERLAPPED | WS_MINIMIZEBOX
iF s<=0 
   mode = SetDisplay(width,height,32)
   iF mode =-2  
      s= WS_OVERLAPPED | WS_MINIMIZEBOX 
   Else   
      s= WS_POPUP
   End iF
End iF
hInst = call GetModuleHandle 0
wc.style = CS_HREDRAW or CS_VREDRAW   
wc.lpfnWndProc = &WndProc
wc.cbClsExtra =0
wc.cbWndExtra =0
wc.hInstance  = hInst
wc.hIcon  = call LoadIconA 0,IDI_WINLOGO            
wc.hCursor= call LoadCursor 0,IDC_ARROW       
wc.hbrBackground = call GetStockObject WHITE_BRUSH 
wc.lpszMenuName  = 0
wc.lpszClassName = StrPtr "window"
call RegisterClass &wc
hwnd = call CreateWindowEx 0,wc.lpszClassName,"",s,0,0,width,height,0,0,hInst,0
call ShowWindow hwnd, SW_SHOW
hdc = call GetDC hwnd
call GetClientRect hwnd,&rc   
w = width - rc.right
h = height- rc.bottom
call GetWindowRect hwnd,&rc
call MoveWindow hwnd,rc.left,rc.top,width+w,height+h,1
bHnd = call CreateCompatibleBitmap hdc,width,height
bHdc = call CreateCompatibleDC hdc
call SelectObject bHdc, bHnd
ScreenWidth = width
ScreenHeight= height
seed = call GetTickCount
QueryPerformanceFrequency sys_qf   
QueryPerformanceCounter   sys_qc1
SetFont 12,24,0,"courier"
Return hwnd
End Function

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

