Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. ; $$$$$$$$$$$$$$$$$$$ ABAKIS $$$$$$$$$$$$$$$$$$$$$
  2. ; *************** STAR^2 SOFTWARE ****************
  3. ; ????????????????? SYSTEM.INC ???????????????????
  4.  
  5. ;;;;;;;;;;;;;;;;;;;;; IMPORT ;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. ; RVAs of dll names and tables, ending with 20
  8. ; zero bytes
  9.  
  10. macro library [names] {
  11.  forward dd 0,0,0,\
  12.   RVA names#_name, RVA names#_table
  13.  common dd 0,0,0,0,0
  14. }
  15.  
  16. ; DLL name + import RVA table. each table ends with 0.
  17. ; finally, import names. dw 0 is "ordinal" (N/A)
  18.  
  19. macro import name, [names] {
  20.  common
  21.   name#_name \            ; text DLL_name='DLL.DLL'
  22.   db `name#'.DLL', 0
  23.   name#_table:            ; DLL_table:
  24.  forward
  25.   IF used !#names
  26.    !#names dd RVA _#names ; import name RVAs
  27.    macro names [p] \{     ; call with no
  28.     \common               ; invoke prefix
  29.      pushr p
  30.      call [!#names]
  31.    \}
  32.   END IF
  33.  common dd 0              ; end
  34.  forward
  35.   IF used !#names
  36.    _#names dw 0           ; import names
  37.    db `names, 0           ; 'import'
  38.   END IF
  39. }
  40.  
  41. ;;;;;;;;;;;;;;;;;;;; IMPORTS ;;;;;;;;;;;;;;;;;;;;;
  42.  
  43. data import
  44.  
  45. library MSVCRT, KERNEL32, USER32, SHELL32,\
  46.  GDI32, COMDLG32
  47.  
  48. import MSVCRT, sprintf
  49.  
  50. import KERNEL32,\
  51. ExitProcess, GetCommandLineA,\
  52. HeapCreate, HeapAlloc, HeapReAlloc, HeapSize,\
  53. HeapFree, HeapDestroy, VirtualAlloc, VirtualFree,\
  54. GetModuleHandleA, GetModuleFileNameA,\
  55. CreateFileA, GetFileSize, ReadFile, WriteFile,\
  56. SetFilePointer, CloseHandle, CopyFileA,\
  57. MoveFileA, DeleteFileA, GetTickCount,\
  58. GetSystemTime, GetLocalTime, GetFileTime,\
  59. FileTimeToSystemTime, SystemTimeToFileTime,\
  60. FileTimeToLocalFileTime,\
  61. SystemTimeToTzSpecificLocalTime,\
  62. GetFileAttributesExA, CompareFileTimeA,\
  63. GetCurrentDirectoryA, SetCurrentDirectoryA,\
  64. CreateDirectoryA, LoadLibraryA, FreeLibrary,\
  65. GetProcAddress, FindFirstFileA, FindNextFileA,\
  66. FindClose, WaitForSingleObject, Sleep
  67.  
  68. import USER32,\
  69. GetDC, ReleaseDC,\
  70. MessageBoxA, RegisterClassExA, CreateWindowExA,\
  71. DestroyWindow, ShowWindow, MoveWindow,\
  72. UpdateWindow, GetMessageA, PeekMessageA,\
  73. TranslateMessage, DispatchMessageA,\
  74. SendMessageA, DefWindowProcA, PostQuitMessage,\
  75. WaitMessage, GetAsyncKeyState, LoadImageA,\
  76. LoadIconA, LoadCursorA, SetCursor, ShowCursor,\
  77. SetCursorPos, OpenClipboard, SetClipboardData,\
  78. IsClipboardFormatAvailable, GetClipboardData,\
  79. CloseClipboard, EmptyClipboard,\
  80. GetSystemMetrics, BeginPaint, EndPaint,\
  81. FillRect, InvalidateRect, SetTimer
  82.  
  83. import SHELL32, ShellExecuteA, ShellExecuteExA
  84.  
  85. import GDI32, SelectObject, DeleteObject,\
  86. GetObjectA, DeleteDC, TextOutA, CreateFontA,\
  87. CreateFontIndirectA, SetDIBits, BitBlt, StretchBlt,\
  88. CreateBitmap, CreateCompatibleDC
  89.  
  90. import COMDLG32, GetOpenFileNameA,\
  91. GetSaveFileNameA, ChooseColorA, ChooseFontA
  92.  
  93. END data
  94.  
  95. ;;;;;;;;;;;;;;;;;;;;; SYSTEM ;;;;;;;;;;;;;;;;;;;;;
  96.  
  97. align
  98.  
  99. void @module, @heap
  100.  
  101. void directory, file.name, command.line
  102.  
  103. ?t equ directory
  104.  
  105. ;;;;;;;;;;;;;;;;;;;; MINIMAL ;;;;;;;;;;;;;;;;;;;;;
  106.  
  107. ; say t     - display message
  108. ; say t, m  - title and message
  109. ; say.n n   - number
  110.  
  111. ; examples:
  112.  
  113. ; say 'Hi'
  114. ; say name
  115. ; say.n 123
  116.  
  117. macro os.say t, m { MessageBoxA 0, m, t, 0 }
  118.  
  119. macro os.ask q, t { MessageBoxA, 0, q, t, 3 }
  120.  
  121. function _say, t, m
  122.   os.say t, m
  123. endf
  124.  
  125. macro say a, b {
  126.   pusha
  127.   IF a eqtype ''
  128.     make.txt r0, a
  129.   ELSE
  130.     . r0=a
  131.   END IF
  132.   IF b eq
  133.     _say r0, r0
  134.   ELSE
  135.     IF b eqtype ''
  136.       make.txt r2, b
  137.     ELSE
  138.       . r2=b
  139.     END IF
  140.     _say r2, r0
  141.   END IF
  142.   popa
  143. }
  144.  
  145. function say.n, n
  146.   locale t(32)
  147.   pusha
  148.   . r1=&t
  149.   u2t n, r1
  150.   . r1=&t
  151.   _say r1, r1
  152.   popa
  153. endf
  154.  
  155. function say.h, n
  156.   locale t(32)
  157.   pusha
  158.   . r1=&t
  159.   h2t n, r1
  160.   . r1=&t
  161.   _say r1, r1
  162.   popa
  163. endf
  164.  
  165. function say.b, n
  166.   locale t(32)
  167.   pusha
  168.   . r1=&t
  169.   b2t n, r1
  170.   . r1=&t
  171.   _say r1, r1
  172.   popa
  173. endf
  174.  
  175. macro sayz t {
  176.  say ?LITERALS+?literals.i
  177.  ?literal t
  178. }
  179.  
  180. macro ask q, t { os.ask q, t }
  181.  
  182. macro cinvoke proc,[arg]
  183.  { common
  184.     size@ccall = 0
  185.     IF ~ arg eq
  186.    reverse
  187.     pushd arg
  188.     size@ccall = size@ccall+4
  189.    common
  190.     END IF
  191.     call [proc]
  192.     IF size@ccall
  193.      add esp,size@ccall
  194.     END IF }
  195.  
  196. macro sprintf t, f, [p] {
  197.  common
  198.   cinvoke !sprintf, t, f, p
  199. }
  200.  
  201. ;;;;;;;;;;;;;;;;;;;;; DEBUG ;;;;;;;;;;;;;;;;;;;;;;
  202.  
  203. bug.t db 'BUG', 0
  204.  
  205. macro bug { say bug.t }
  206.  
  207. macro bug.x t {
  208.  log t
  209.  execute log.file
  210.  exit
  211. }
  212.  
  213. macro BUG { db 0CCh } ; int3 breakpoint
  214.  
  215. ;;;;;;;;;;;;;;;;;;;; MEMORY ;;;;;;;;;;;;;;;;;;;;;;
  216.  
  217. macro os.memory
  218.  { get @heap=HeapCreate 0, 0, 0 }
  219.  
  220. macro os.allocate n { HeapAlloc @heap, 0, n }
  221.  
  222. macro os.reallocate p, n
  223.  { HeapReAlloc @heap, 0, p, n }
  224.  
  225. macro os.destroy p { HeapFree @heap, 0, p }
  226.  
  227. ;;;;;;;;;;;;;;; ALLOCATE, DESTROY ;;;;;;;;;;;;;;;;
  228.  
  229. ; allocate n
  230. ; allocate.p &p, n
  231. ; destroy &p
  232.  
  233. ; example: try p=allocate 4*KB
  234.  
  235. function allocate, n
  236.   os.allocate n
  237. endf
  238.  
  239. function allocate.p, p, n
  240.   if p=0
  241.     allocate n
  242.     return
  243.   end
  244.   os.reallocate p, n
  245. endf
  246.  
  247. function destroy, p
  248.   if p
  249.     os.destroy p
  250.   end
  251. endf
  252.  
  253. macro destroy [p] { forward destroy p }
  254.  
  255. ;;;;;;;;;;;;;;;;;;;;; TIME ;;;;;;;;;;;;;;;;;;;;;;;
  256.  
  257. FILE.TIME fix u64
  258.  
  259. macro os.get.time {
  260.  GetLocalTime local.time
  261.  update.time local.time
  262. }
  263.  
  264. function os.delay, ms
  265.   locals start
  266.   get start=GetTickCount
  267.   @@:
  268.    GetTickCount
  269.    . r1=start, r1+ms
  270.    cmp r0, r1
  271.   jb @b
  272. endf
  273.  
  274. get.clock fix GetTickCount
  275.  
  276. ;;;;;;;;;;;;;;;;;;;;; RANDOM ;;;;;;;;;;;;;;;;;;;;;
  277.  
  278. align integer @seed
  279.  
  280. ; generate unique random number: 0-n
  281.  
  282. ; seed=(seed*343FDh)+269EC3h
  283. ; seed=((seed>>16)&7FFFh)/(n+1)
  284.  
  285. function random, n
  286.   . r0=@seed
  287.   if false       ; initialize seed
  288.     rdtsc        ; read date/time stamp counter
  289.     . @seed=r0
  290.   end
  291.   . r0*343FDh, r0+269EC3h,\
  292.   @seed=r0, r0>>16, r0&7FFFh,\
  293.   r1=n, r1+1, r0/r1, r0=r2
  294. endf
  295.  
  296. ; random(from-to-2)+from
  297.  
  298. function random.x, from, to
  299.   . r0=from, r0-to, r0-2
  300.   random r0
  301.   . r0+from
  302. endf
  303.  
  304. ;;;;;;;;;;;;;;;;;;; FILE I/O ;;;;;;;;;;;;;;;;;;;;;
  305.  
  306. numeric EOF=-1,\
  307.  CREATE_NEW=1, CREATE_ALWAYS, OPEN_EXISTING,\
  308.  OPEN_ALWAYS, TRUNCATE_EXISTING,\
  309.  GENERIC_READ=80000000h, GENERIC_WRITE=40000000h,\
  310.  FILE_SHARE_READ=1, FILE_SHARE_WRITE,\
  311.  FILE_ATTRIBUTE_NORMAL=80h,\
  312.  SEEK.BEGIN=0, SEEK.SET, SEEK.END
  313.  
  314. ;;;;;;;;;;;;;;;;; CURRENT FILE ;;;;;;;;;;;;;;;;;;;
  315.  
  316. align
  317.  
  318. void file.p       ; pointer for load/save
  319. integer file.h,\  ; handle
  320.  file.n64, file.n ; size 64:32
  321. integer tmp.rw
  322.  
  323. macro flush { destroy file.p }
  324.  
  325. ; return handle or -1 if error
  326.  
  327. function os.create.file, file, access, share,\
  328.   security, action, attributes, template
  329.   call !text.copy, file.name, file
  330.   CreateFileA file.name, access, share,\
  331.    security, action, attributes, template
  332.   . file.h=r0
  333. endf
  334.  
  335. macro os.open file {
  336.  os.create.file file, GENERIC_READ \
  337.   or GENERIC_WRITE, FILE_SHARE_READ,\
  338.   0, OPEN_EXISTING, 0, 0
  339. }
  340.  
  341. macro os.create file {
  342.  os.create.file file, GENERIC_WRITE,\
  343.   0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0
  344. }
  345.  
  346. macro os.seek n, r
  347.  { SetFilePointer file.h, n, 0, r }
  348.  
  349. macro os.read p, n {
  350.  . r0=&tmp.rw
  351.  ReadFile file.h, p, n, r0, 0
  352. }
  353.  
  354. macro os.write p, n {
  355.  . r0=&tmp.rw
  356.  WriteFile file.h, p, n, r0, 0
  357. }
  358.  
  359. macro os.get.file.size { GetFileSize file.h, 0 }
  360.  
  361. macro os.close { CloseHandle file.h }
  362.  
  363. ;;;;;;;;;;;;;;; COPY, MOVE, DELETE ;;;;;;;;;;;;;;;
  364.  
  365. macro copy.file a, b, r { CopyFileA a, b, r }
  366. macro move.file a, b    { MoveFileA a, b }
  367. macro delete.file f     { DeleteFileA f }
  368. macro rename.file a,{ os.move.file a, b }
  369.  
  370. ;;;;;;;;;;;;;;;;;; DIRECTORIES ;;;;;;;;;;;;;;;;;;;
  371.  
  372. macro os.get.directory
  373.  { GetCurrentDirectoryA 256, directory }
  374.  
  375. macro os.set.directory f
  376.  { SetCurrentDirectoryA f }
  377.  
  378. macro os.create.directory f
  379.  { CreateDirectoryA f, 0 }
  380.  
  381. macro os.get.file.name
  382.  { GetModuleFileNameA 0, directory, 1*KB }
  383.  
  384. macro os.get.command.line { GetCommandLineA }
  385.  
  386. ;;;;;;;;;;;;;;;;;;;; EXECUTE ;;;;;;;;;;;;;;;;;;;;;
  387.  
  388. macro execute file
  389.  { ShellExecuteA 0, 0, file, 0, 0, 3 }
  390.  
  391. ;;;;;;;;;;;;;;;;;; FIND FILES ;;;;;;;;;;;;;;;;;;;;
  392.  
  393. macro os.find.data {
  394.  BLOCK find.data(338) ; WIN32_FIND_DATA
  395.  os.found.file equ find.data+44
  396. }
  397.  
  398. macro os.find.first file
  399.  { FindFirstFileA file, find.data }
  400.  
  401. macro os.find.next
  402.  { FindNextFileA find.data.h, find.data }
  403.  
  404. macro os.find.end { FindClose find.data.h }
  405.  
  406. ;;;;;;;;;;;;;;;;;;;;; REDRAW ;;;;;;;;;;;;;;;;;;;;;
  407.  
  408. macro create.blank.screen w, h {
  409.   create.vga os.w, os.h, WHITE ; 0
  410.   create.blank.window w, h
  411. }
  412.  
  413. macro redraw {
  414.  calle draw
  415. }
  416.  
  417. macro render b {
  418.  ; call !clear.screen
  419.  IF b eq
  420.   redraw
  421.  END IF
  422.  IF used cursor
  423.   call !draw.cursor, cursor
  424.  END IF
  425.  IF b eq
  426.   call !show.vga
  427.  ELSE
  428.   copy.box box, b
  429.   call !show.vga.box
  430.  END IF
  431. }
  432.  
  433. ;;;;;;;;;;;;;;;;;;;; WINDOZE ;;;;;;;;;;;;;;;;;;;;;
  434.  
  435. macro POINT [a] { a: integer a#.x, a#.y }
  436.  
  437. macro RECT [a] { a: integer a#.left,\
  438.  a#.top, a#.right, a#.bottom }
  439.  
  440. macro MSG [a] {
  441.  a: integer a#.hwnd, a#.message,\
  442.  a#.wParam, a#.lParam, a#.time
  443.  POINT a#.pt
  444. }
  445.  
  446. macro WNDCLASSEX [a] {
  447.  a: integer a#.cbSize=48,\
  448.  a#.style, a#.lpfnWndProc, a#.cbClsExtra,\
  449.  a#.cbWndExtra, a#.hInstance, a#.hIcon,\
  450.  a#.hCursor, a#.hbrBackground,\
  451.  a#.lpszMenuName, a#.lpszClassName, a#.hIconSm
  452.  WNDCLASSEX.$=$-a
  453. }
  454.  
  455. macro PAINTSTRUCT [a] {
  456.  a: integer a#.hdc, a#.fErase
  457.  RECT a#.rcPaint
  458.  integer a#.fRestore, a#.fIncUpdate
  459.  text a#.rgbReserved(32)
  460. }
  461.  
  462. macro BITMAP [a] {
  463.  a: integer a#.bmType,\
  464.   a#.bmWidth, a#.bmHeight, a#.bmWidthBytes
  465.  short a#.bmPlanes, a#.bmBitsPixel
  466.  void a#.bmBits
  467.  BITMAP.$=$-a
  468. }
  469.  
  470. macro BITMAPINFOHEADER [a] {
  471.  a: integer a#.biSize, a#.biWidth, a#.biHeight
  472.  short a#.biPlanes, a#.biBitCount
  473.  integer a#.biCompression, a#.biSizeImage,\
  474.   a#.biXPelsPerMeter, a#.biYPelsPerMeter,\
  475.   a#.biClrUsed, a#.biClrImportant
  476.  BITMAPINFOHEADER.$=$-a
  477. }
  478.  
  479. macro BITMAPINFO [a] {
  480.   BITMAPINFOHEADER a
  481.   integer bmiColors
  482.   BITMAPINFO.$=BITMAPINFOHEADER.$+4
  483. }
  484.  
  485. ; window messages
  486.  
  487. numeric WM_*, \
  488.  CREATE=1, DESTROY=2, MOVE=3, SIZE=5,\
  489.  SETFOCUS=7, KILLFOCUS=8, GETTEXT=0Dh,\
  490.  SETTEXT=0Ch, GETTEXTLENGTH=0Eh,\
  491.  PAINT=0Fh, CLOSE=10h, QUIT=12h, CUT=300h,\
  492.  COPY=301h, PASTE=302h, CLEAR=303h,\
  493.  SETFONT=30h, COMMAND=111h, TIMER=0113h
  494.  
  495. ; window styles
  496.  
  497. numeric WS_*, \
  498.  POPUP=80000000h, MINIMIZE=20000000h,\
  499.  VISIBLE=10000000h, MAXIMIZE=1000000h,\
  500.  CAPTION=0C00000h, BORDER=800000h,\
  501.  DLGFRAME=400000h, VSCROLL=200000h,\
  502.  HSCROLL=100000h, SYSMENU=80000h,\
  503.  THICKFRAME=40000h, MINIMIZEBOX=20000h,\
  504.  MAXIMIZEBOX=10000h
  505.  
  506. WS_BLANK   = WS_VISIBLE+WS_POPUP
  507. WS_DEFAULT = WS_VISIBLE+WS_CAPTION+\
  508.              WS_MINIMIZEBOX+WS_SYSMENU
  509.  
  510. CS_DBLCLKS=8
  511.  
  512. ; keyboard+mouse messages
  513.  
  514. numeric WM_*,\
  515.  KEYDOWN=100h, KEYUP, CHAR, DEADCHAR,\
  516.  SYSKEYDOWN, SYSKEYUP, SYSCHAR
  517.  
  518. numeric WM_*,\
  519.  MOUSEMOVE=200h, LBUTTONDOWN, LBUTTONUP,\
  520.  LBUTTONDBLCLK, RBUTTONDOWN, RBUTTONUP,\
  521.  RBUTTONDBLCLK, MBUTTONDOWN, MBUTTONUP,\
  522.  MBUTTONDBLCLK, MOUSEWHEEL
  523.  
  524. ; virtual key codes. function keys=(6Fh+N).
  525. ; example: F1=70h (6Fh+1)
  526.  
  527. numeric K.*,\
  528.  FUNCTION=6Fh, LEFT=25h, UP=26h, RIGHT=27h,\
  529.  DOWN=28h, ESCAPE=1Bh, SPACE=20h, DELETE=2Eh,\
  530.  CONTROL=11h, LCONTROL=0A2h, RCONTROL=0A3h,\
  531.  LALT=0A4h, RALT=0A5h, BACK=8, TAB=9,\
  532.  RETURN=0Dh, END=23h, HOME=24h,\
  533.  A='A', S='S', D='D', W='W'
  534.  
  535. SRCCOPY=00CC0020h
  536.  
  537. macro os.show.cursor { ShowCursor 1 }
  538.  
  539. ;;;;;;;;;;;;;;;;;;;;; SYSTEM ;;;;;;;;;;;;;;;;;;;;;
  540.  
  541. align
  542.  
  543. integer os.w, os.h, os.bpp
  544.  
  545. void _hwnd      ; handle
  546. void _dc        ; device context
  547. void _mdc       ; memory dc
  548.  
  549. WNDCLASSEX _wc  ; window
  550. MSG _wm         ; message
  551. PAINTSTRUCT _ps ; for PAINT
  552. BITMAP _bm      ; for draw.bitmap.w
  553.  
  554. void vga.hbm
  555. BITMAPINFO vga.bmi
  556. RECT vga.rect
  557.  
  558. text _cn='WC', _wt='' ; classname, title
  559.  
  560. ;;;;;;;;;;;;;;;;; CREATE WINDOW ;;;;;;;;;;;;;;;;;;
  561.  
  562. function create.window.x, style, procedure,\
  563.  w, h, title, class.name
  564.   locals x, y
  565.  
  566.   . _wc.cbSize=WNDCLASSEX.$
  567.   . _wc.hInstance=@module
  568.   . _wc.lpfnWndProc=procedure
  569.   . _wc.lpszClassName=class.name
  570.   . _wc.style=CS_DBLCLKS, _wc.hbrBackground=8
  571.   get _wc.hIcon=LoadIconA 0, 7F00h
  572.   get _wc.hCursor=LoadCursorA 0, 7F00h
  573.  
  574.   try RegisterClassExA _wc
  575.  
  576.   . r0=os.w, r0>>1, r2=w, r2>>1, r0-r2, x=r0
  577.   . r0=os.h, r0>>1, r2=h, r2>>1, r0-r2, y=r0
  578.  
  579.   try _hwnd=CreateWindowExA 0, class.name,\
  580.    title, style, x, y, w, h, 0, 0, @module, 0
  581. endf 1
  582.  
  583. macro create.blank.window w, h {
  584.  create.window.x WS_BLANK, !_window.procedure,\
  585.   w, h, _wt, _wc
  586. }
  587.  
  588. macro create.default.window title {
  589.  create.window.x WS_DEFAULT, !_window.procedure,\
  590.   os.w, os.h, title, _wc
  591. }
  592.  
  593. ;;;;;;;;;;;;;;;;;; MESSAGE LOOP ;;;;;;;;;;;;;;;;;;
  594.  
  595. macro begin.message.loop {
  596.  .begin.ml:
  597.  GetMessageA _wm, 0, 0, 0
  598.  fail .end.ml
  599.  TranslateMessage _wm
  600.  DispatchMessageA _wm
  601. }
  602.  
  603. macro end.message.loop {
  604.  go .begin.ml
  605.  .end.ml:
  606.  . r0=_wm.wParam
  607. }
  608.  
  609. macro message.loop {
  610.  begin.message.loop
  611.  end.message.loop
  612. }
  613.  
  614. macro process.messages {
  615.  .begin.ml:
  616.  PeekMessageA _wm, 0, 0, 0, 0
  617.  fail .no.message
  618.  GetMessageA _wm, 0, 0, 0
  619.  fail .end.ml
  620.  TranslateMessage _wm
  621.  DispatchMessageA _wm
  622.  go .begin.ml
  623.  .no.message:
  624. }
  625.  
  626. macro end.messages {
  627.  go .begin.ml
  628.  .end.ml:
  629.  ExitProcess _wm.wParam
  630. }
  631.  
  632. macro minimize.window { ShowWindow _hwnd, 6 }
  633.  
  634. ;;;;;;;;;;;;;;;;;;;;;; INPUT ;;;;;;;;;;;;;;;;;;;;;
  635.  
  636. align 4
  637.  
  638. integer event.id, key.event, mouse.event,\
  639.  key, any.key, key.c, exit.if.esc=YES,\
  640.  mouse.1, mouse.2, mouse.x, mouse.y,\
  641.  mouse.px, mouse.py, mouse.double, mouse.wheel,\
  642.  mouse.drag, mouse.drag.x, mouse.drag.y,\
  643.  mouse.drop, mouse.drop.x, mouse.drop.y
  644.  
  645. macro os.key.state k { GetAsyncKeyState k }
  646.  
  647. macro os.set.cursor.xy x, y
  648.  { SetCursorPos x, y }
  649.  
  650. function key.state, k
  651.   os.key.state k
  652. endf
  653.  
  654. ; if key state
  655.  
  656. macro if.key k { !if key.state K.#k }
  657. macro if.not.keys k { !if.n key.state K.#k }
  658.  
  659. function select.box, box
  660.   . r0=mouse.x, r1=mouse.y
  661.   IF defined cursor
  662.     . r0+cursor.spot.x, r1+cursor.spot.y
  663.   END IF
  664.   call !point.inside, box, r0, r1
  665. endf
  666.  
  667. macro if.select box { !if select.box, box }
  668. macro else.if.select box
  669.  { !else.if select.box, box }
  670.  
  671. macro if.not.select box
  672.  { !if.n select.box, box }
  673.  
  674. macro if.click box {
  675.   select.box box
  676.   and r0, mouse.1
  677.   if true
  678. }
  679.  
  680. ;;;;;;;;;;;;;;;;;;;;; EVENTS ;;;;;;;;;;;;;;;;;;;;;
  681.  
  682. align
  683. void !_on.event, !on.main,\
  684.  !_on.create, !_on.destroy, !_on.close,\
  685.  !_on.draw, !_on.game, !_on.command,\
  686.  !_on.key, !_on.mouse, !_on.timer, !_on.exit
  687.  
  688. macro define.events [e]
  689.  { mov [!!_on.#e], !on.#e }
  690.  
  691. macro calle e {
  692.  if dword [!!_on.#e]
  693.   call dword [!!_on.#e]
  694.  end
  695. }
  696.  
  697. !call fix calle
  698.  
  699. macro !on name { function on.#name }
  700. macro !end { endf 1 }
  701.  
  702. ;;;;;;;;;;;;;;;;;;;;; TIMER ;;;;;;;;;;;;;;;;;;;;;;
  703.  
  704. macro os.set.timer f, ms
  705.  { SetTimer _hwnd, 1, ms, f }
  706.  
  707. macro set.timer a, b {
  708.  IF b eq
  709.   os.set.timer !on.timer, a
  710.  ELSE
  711.   os.set.timer a, b
  712.  END IF
  713. }
  714.  
  715. ;;;;;;;;;;;;;;;; WINDOW PROCEDURE ;;;;;;;;;;;;;;;;
  716.  
  717. function _window.procedure, window, message, wp, lp
  718.   alias m=r0
  719.   . m=message, event.id=0, mouse.double=0
  720.  
  721.   if m=WM_PAINT
  722.     get _dc=BeginPaint _hwnd, _ps
  723.     render
  724.     EndPaint _hwnd, _ps
  725.     go .default
  726.  
  727.   else.if m=WM_COMMAND
  728.     calle command
  729.  
  730.   else.if m=WM_KEYDOWN
  731.     . key=wp, event.id='k', key.event='k'
  732.     if exit.if.esc
  733.       if wp=K.ESCAPE
  734.         SendMessageA window, WM_DESTROY, 0, 0
  735.       end
  736.     end
  737.     .key:
  738.     calle key
  739.     return 0
  740.  
  741.   else.if m=WM_KEYUP
  742.     . key=NO, event.id='k', key.event='r'
  743.     go .key
  744.  
  745.   else.if m=WM_CHAR
  746.     . key=wp, event.id='k', key.event='c'
  747.     go .key
  748.  
  749.   else.if m=WM_MOUSEMOVE
  750.     . mouse.event='m'
  751.     if mouse.1
  752.       if not mouse.drag
  753.         . mouse.drag=YES,\
  754.         mouse.drag.x=mouse.x,\
  755.         mouse.drag.y=mouse.y
  756.       end
  757.     end
  758.     .mouse:
  759.      . event.id='m', r0=lp, r1=r0,\
  760.      r0&0FFFFh, mouse.x=r0,\
  761.      r1>>16, r1&0FFFFh, mouse.y=r1
  762.     calle mouse
  763.     if mouse.event='m'
  764.       . mouse.px=mouse.x,\
  765.        mouse.py=mouse.y
  766.     end
  767.     return 0
  768.  
  769.   else.if m=WM_LBUTTONDOWN
  770.     . mouse.event='c', mouse.1=YES,\
  771.     mouse.drop=NO
  772.     go .mouse
  773.  
  774.   else.if m=WM_LBUTTONUP
  775.     . mouse.event='r', mouse.1=NO
  776.     if mouse.drag
  777.       . mouse.drop=YES,\
  778.       mouse.drop.x=mouse.x,\
  779.       mouse.drop.y=mouse.y,\
  780.       mouse.drag=NO
  781.     end
  782.     go .mouse
  783.  
  784.   else.if m=WM_LBUTTONDBLCLK
  785.     . mouse.double=YES
  786.     go .mouse
  787.  
  788.   else.if m=WM_RBUTTONDOWN
  789.     . mouse.event='rc', mouse.2=YES
  790.     go .mouse
  791.  
  792.   else.if m=WM_RBUTTONUP
  793.     . mouse.event='rr', mouse.2=NO
  794.     go .mouse
  795.  
  796.   else.if m=WM_MOUSEWHEEL
  797.     . mouse.event='w', r1=wp,\
  798.     r1>>16, mouse.wheel=r1
  799.     go .mouse
  800.  
  801.   else.if m=WM_CREATE
  802.     calle create
  803.     go .default
  804.  
  805.   else.if m=WM_DESTROY
  806.     .destroy:
  807.     calle destroy
  808.     PostQuitMessage 0
  809.   end
  810.  
  811.   .default: DefWindowProcA \
  812.    window, message, wp, lp
  813. endf
  814.  
  815. ;;;;;;;;;;;;;;; LOAD/DRAW H/BITMAP ;;;;;;;;;;;;;;;
  816.  
  817. function load.bitmap.w, file
  818.   locals p
  819.   try p=LoadImageA @module, file, 0, 0, 0, 10h
  820.   GetObjectA p, BITMAP.$, _bm
  821. endf p
  822.  
  823. function draw.bitmap.w, hbmp, x, y, w, h
  824.   locals bmw, bmh
  825.   GetObjectA hbmp, BITMAP.$, _bm
  826.   . bmw=_bm.bmWidth, bmh=_bm.bmHeight
  827.   get _mdc=CreateCompatibleDC _dc
  828.   SelectObject _mdc, hbmp
  829.   StretchBlt _dc, x, y, w, h,\
  830.    _mdc, 0, 0, bmw, bmh, SRCCOPY
  831.   DeleteDC _mdc
  832. endf
  833.  
  834. ;;;;;;;;;;;;;;;;;;;;;; VGA ;;;;;;;;;;;;;;;;;;;;;;;
  835.  
  836. macro os.get.screen.w
  837.  { get os.w=GetSystemMetrics 0 }
  838.  
  839. macro os.get.screen.h
  840.  { get os.h=GetSystemMetrics 1 }
  841.  
  842. function os.create.vga, w, h
  843.   alias p=r0, x=r1
  844.   ; set.screen screen.w, screen.h, screen.bpp
  845.   try vga.hbm=CreateBitmap \
  846.    screen.w, screen.h, 32, 1, vga.p
  847.   memory.zero vga.bmi, BITMAPINFOHEADER.$
  848.   . vga.bmi.biSize=BITMAPINFOHEADER.$
  849.   . vga.bmi.biWidth=screen.w
  850.   . x=screen.h, neg x, vga.bmi.biHeight=x
  851.   . vga.bmi.biPlanes=1, vga.bmi.biBitCount=32
  852. endf
  853.  
  854. function os.show.vga
  855.   SetDIBits _dc, vga.hbm, 0, screen.h,\
  856.    vga.p, vga.bmi, 0
  857.   draw.bitmap.w vga.hbm, 0, 0, screen.w, screen.h
  858.   . vga.rect.left=0, vga.rect.top=0,\
  859.    vga.rect.right=screen.w,\
  860.    vga.rect.bottom=screen.h
  861.   InvalidateRect _hwnd, vga.rect, 0
  862. endf
  863.  
  864. function show.vga.box
  865.   SetDIBits _dc, vga.hbm, 0, screen.h,\
  866.    vga.p, vga.bmi, 0
  867.   draw.bitmap.w vga.hbm,\
  868.    box.x, box.y, box.w, box.y
  869.   . r0=box.x, r1=box.y,\
  870.    vga.rect.left=r0, vga.rect.top=r1,\
  871.    r0+box.w, vga.rect.right=r0,\
  872.    r1+box.h, vga.rect.bottom=r1
  873.   InvalidateRect _hwnd, vga.rect, 0
  874. endf
  875.  
  876. macro show.vga.box b {
  877.   IF ~b eq
  878.     copy.box box, b
  879.   END IF
  880.   show.vga.box
  881. }
  882.  
  883. macro define.vga { os.define.vga }
  884.  
  885. ; create vga/buffer for drawing
  886.  
  887. function create.vga, w, h, c
  888.   if vga.p=0, r0=w, r0*h, r0<<2
  889.     try vga.p=allocate r0
  890.   end
  891.   call !clear.screen, c
  892.   os.create.vga w, h
  893. endf 1
  894.  
  895. function show.vga
  896.   os.show.vga
  897. endf
  898.  
  899. function set.vga, w, h
  900.   os.set.vga
  901. endf
  902.  
  903. function end.vga
  904.   destroy vga
  905.   os.end.vga
  906. endf
  907.  
  908. ;;;;;;;;;;;;;;;;;; ENTER+EXIT ;;;;;;;;;;;;;;;;;;;;
  909.  
  910. ; user-defined enter/exit routines will be called
  911. ; if defined/nonzero
  912.  
  913. function os.enter
  914.   try @module=GetModuleHandleA 0
  915.   try @heap=HeapCreate 0, 0, 0
  916.   try directory=allocate 1*KB
  917.   . r0=directory, *r0=0
  918.   try file.name=allocate 1*KB
  919.   . r0=file.name, *r0=0
  920.   os.get.directory
  921.   os.get.command.line
  922.   . command.line=r0
  923. endf 1
  924.  
  925. function exit
  926.   ExitProcess 0
  927. endf
  928.  
  929. ;;;;;;;;;;;;; EXECUTABLE STRUCTURE ;;;;;;;;;;;;;;;
  930.  
  931. align
  932.  
  933. section '.one' \
  934.  code readable writable executable
  935.  !main:
  936.   os.enter
  937.   if false
  938.     say 'System error'
  939.     exit
  940.   end
  941.   call !main!
  942.   exit
  943.   ret
  944.  
  945. function main!
  946.   os.get.screen.w
  947.   os.get.screen.h
  948.   set.screen WINDOW.W, WINDOW.H, 32
  949.   try create.vga screen.w, screen.h, BLACK
  950.   define.events create, draw, key, mouse
  951.   create.blank.window screen.w, screen.h
  952.   os.show.cursor
  953.   message.loop
  954. endf
  955.  
  956. align