showcase_primitives.mod 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103
  1. MODULE showcase_primitives ;
  2. (*
  3. m2SDL showcase, ported from SDL-main
  4. examples/renderer/02-primitives/primitives.c (public domain).
  5. Draws a filled rectangle, 500 random points, an inset outline
  6. and a yellow X across the canvas every frame.
  7. SDL3 -> SDL2 adaptations
  8. - SDL_RenderRect/RenderPoints become SDL2
  9. SDL_RenderDrawRect / SDL_RenderDrawPoints.
  10. - SDL_FPoint floats become integer SDLPoint; SDL_randf is
  11. replaced by libc rand seeded from SDL_GetTicks.
  12. - Point array passes as ADR(points) + count (see SDLRender).
  13. - Callback structure flattened into a main loop; auto-quit
  14. after 8 s so the showcase also terminates unattended.
  15. *)
  16. FROM SYSTEM IMPORT ADDRESS, ADR, CARDINAL8;
  17. FROM SDL2 IMPORT SDL_Init, SDL_Quit, SDL_Delay,
  18. SDL_GetTicks, SDL_GetTicks64, SDLInitVideo;
  19. FROM SDLVideo IMPORT WindowHandle, SDL_DestroyWindow, WindowResizable;
  20. FROM SDLRender IMPORT RendererHandle,
  21. SDL_CreateWindowAndRenderer, SDL_DestroyRenderer,
  22. SDL_SetRenderDrawColor, SDL_RenderClear, SDL_RenderPresent,
  23. SDL_RenderSetLogicalSize,
  24. SDL_RenderDrawLine, SDL_RenderDrawRect, SDL_RenderDrawPoints,
  25. SDL_RenderFillRect;
  26. FROM SDLRect IMPORT SDLRect, SDLPoint, MakeRect, MakePoint;
  27. FROM SDLUtils IMPORT DrainEvents;
  28. FROM libc IMPORT printf, rand, srand;
  29. CONST FrameMs = 16; MaxMs = 8000;
  30. CONST WinW = 640; WinH = 480; NPoints = 500;
  31. VAR
  32. win: WindowHandle;
  33. ren: RendererHandle;
  34. points: ARRAY [0..NPoints-1] OF SDLPoint;
  35. rect: SDLRect;
  36. quit: BOOLEAN;
  37. start: LONGCARD;
  38. i: INTEGER;
  39. BEGIN
  40. IF SDL_Init(SDLInitVideo) # 0 THEN
  41. printf("showcase_primitives: SDL_Init failed\n");
  42. HALT(1)
  43. END;
  44. IF SDL_CreateWindowAndRenderer(WinW, WinH, WindowResizable,
  45. win, ren) # 0 THEN
  46. printf("showcase_primitives: CreateWindowAndRenderer failed\n");
  47. SDL_Quit;
  48. HALT(1)
  49. END;
  50. SDL_RenderSetLogicalSize(ren, WinW, WinH);
  51. (* scatter the points inside the blue rectangle, as in the C code. *)
  52. srand(VAL(INTEGER, SDL_GetTicks()));
  53. FOR i := 0 TO NPoints - 1 DO
  54. points[i] := MakePoint(rand() MOD 440 + 100, rand() MOD 280 + 100)
  55. END;
  56. printf("showcase_primitives: close window or wait 8s\n");
  57. quit := FALSE;
  58. start := SDL_GetTicks64();
  59. WHILE NOT quit DO
  60. DrainEvents(quit);
  61. SDL_SetRenderDrawColor(ren, VAL(CARDINAL8, 33), VAL(CARDINAL8, 33),
  62. VAL(CARDINAL8, 33), VAL(CARDINAL8, 255));
  63. SDL_RenderClear(ren);
  64. rect := MakeRect(100, 100, 440, 280);
  65. SDL_SetRenderDrawColor(ren, VAL(CARDINAL8, 0), VAL(CARDINAL8, 0),
  66. VAL(CARDINAL8, 255), VAL(CARDINAL8, 255));
  67. SDL_RenderFillRect(ren, rect);
  68. SDL_SetRenderDrawColor(ren, VAL(CARDINAL8, 255), VAL(CARDINAL8, 0),
  69. VAL(CARDINAL8, 0), VAL(CARDINAL8, 255));
  70. SDL_RenderDrawPoints(ren, ADR(points), NPoints);
  71. rect := MakeRect(130, 130, 380, 220);
  72. SDL_SetRenderDrawColor(ren, VAL(CARDINAL8, 0), VAL(CARDINAL8, 255),
  73. VAL(CARDINAL8, 0), VAL(CARDINAL8, 255));
  74. SDL_RenderDrawRect(ren, rect);
  75. SDL_SetRenderDrawColor(ren, VAL(CARDINAL8, 255), VAL(CARDINAL8, 255),
  76. VAL(CARDINAL8, 0), VAL(CARDINAL8, 255));
  77. SDL_RenderDrawLine(ren, 0, 0, WinW, WinH);
  78. SDL_RenderDrawLine(ren, 0, WinH, WinW, 0);
  79. SDL_RenderPresent(ren);
  80. IF SDL_GetTicks64() - start > MaxMs THEN quit := TRUE END;
  81. SDL_Delay(FrameMs)
  82. END;
  83. SDL_DestroyRenderer(ren);
  84. SDL_DestroyWindow(win);
  85. SDL_Quit;
  86. printf("showcase_primitives: bye\n")
  87. END showcase_primitives.