'===========================================================================
' Subject: GDI TEST CODE                      Date: 06-27-98 (00:00)       
'  Author: Dave Navarro, Jr.                  Code: PBCC                   
'  Origin: dave@powerbasic.com              Packet: PBCC.ABC
'===========================================================================
'
' GDI.BAS test code for PB/CC 1.0
' by Dave Navarro, Jr. (dave@powerbasic.com)
'
%CCWIN = 1

$INCLUDE "WIN32API.INC"  'you must remove the $IF %DEF() lines from WIN32API.INC

DEFSNG A-Z

FUNCTION FF(x AS SINGLE, y AS SINGLE)
  GLOBAL W AS SINGLE
  FUNCTION = 14 * EXP(-.04*W)*COS(.15*W)
END FUNCTION

SUB PLOT(BYVAL hWnd AS LONG)

  LOCAL LpPaint   AS PaintStruct
  LOCAL hDC       AS LONG
  LOCAL hMemDC    AS LONG
  LOCAL hBmp      AS LONG
  LOCAL hBrush    AS LONG
  LOCAL hPen      AS LONG
  LOCAL WinX      AS LONG
  LOCAL WinY      AS LONG
  LOCAL r         AS RECT
  LOCAL i         AS LONG
  LOCAL FL        AS LONG
  LOCAL yOfs      AS LONG

  STATIC PHI AS SINGLE

  GetClientRect hWnd, r
  WinX = r.nRight - r.nLeft
  WinY = r.nBottom - r.nTop

  hDC = BeginPaint(hWnd, LpPaint)
  hMemDC = CreateCompatibleDC(hDC)
  hBmp = CreateCompatibleBitmap(hDC, WinX, WinY)

  SelectObject hMemDC, hBmp

  hBrush = CreateSolidBrush(%BLACK)
  FillRect hMemDC, r, hBrush
  DeleteObject hBrush

  yOfs = WinY * .3

  hPen = CreatePen(%PS_SOLID, 2, %GREEN)
  SelectObject hMemDC, hPen

  RHO = 300 - ((WinX / 800) * 300)
  D = 2000

  THETA = .1
  S1 = SIN(THETA)
  C1 = COS(THETA)

  IF PHI THEN
    PHI = PHI+0.1
  ELSE
    PHI = 1.3
  END IF
  S2 = SIN(PHI)
  C2 = COS(PHI)

  DIM YMIN(0 to WinX), YMAX(0 to WinX)
  FOR I = 0 TO WinX : YMIN(I) = WinY \ 2 : NEXT I

  FOR X = 12 TO -12 STEP -.5
    FL = 0
    FOR Y = -12 TO 12 STEP .2
      W = X*X + Y*Y
      Z = FF(X, Y)

      XE = -X*S1 + Y*C1
      YE = -X*C1*C2 - Y*S1*C2 + Z*S2
      ZE = -X*S2*C1 - Y*S1*S2 - Z*S2 + RHO
      SX = D*XE/ZE + (WinX \ 2)
      SY = (-5*D*YE/ZE/12) + 120

      IF SX < 0 OR SX > WinX THEN OutOfRange
      IF FL = 0 THEN FL = 1 : F = 0 : GOTO OutOfRange
      DX = OLDX - SX : IF DX = 0 THEN DX = 1
      SL = (OLDY - SY) / DX
      YP = OLDY

      FOR XP = INT(OLDX) + 1 TO SX
        YP = YP + SL
        IF YP <= YMIN(XP) THEN
          YMIN(XP) = YP
          IF F = 0 THEN XX = XP: YY = YP : F = 1
          MoveToEx hMemDC, XX, YY+yOfs, BYVAL %NULL
          LineTo hMemDC, XP, YP+yOfs
          XX = XP
          YY = YP
        END IF
        IF YP >= YMAX(XP) THEN
          YMAX(XP) = YP
          IF F = 0 THEN XX = XP: YY = YP : F = 1
          MoveToEx hMemDC, XX, YY+yOfs, BYVAL %NULL
          LineTo hMemDC, XP, YP+yOfs
          XX = XP
          YY = YP
        END IF
        F = 0
      NEXT XP
OutOfRange:
      OLDX = SX : OLDY = SY
    NEXT Y
  NEXT X

  BitBlt hDC, r.nLeft, r.nTop, Winx, WinY, hMemDC, 0, 0, %SRCCOPY
  EndPaint hWndShow, LpPaint

  DeleteObject hPen

END SUB

FUNCTION WinMain (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  lpCmdLine           AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG

  LOCAL Msg         AS tagMsg
  LOCAL wndclass    AS WndClassEx
  LOCAL szAppName   AS ASCIIZ * 80
  LOCAL hWnd        AS LONG

  szAppName              = "GDIWINDOW"

  wndclass.cbSize        = SIZEOF(WndClass)
  wndclass.style         = %CS_HREDRAW OR %CS_VREDRAW

  wndclass.lpfnWndProc   = CODEPTR( WndProc )

  wndclass.cbClsExtra    = 0
  wndclass.cbWndExtra    = 0
  wndclass.hInstance     = hInstance
  wndclass.hIcon         = %NULL
  wndclass.hCursor       = LoadCursor( %NULL, BYVAL %IDC_ARROW )
  wndclass.hbrBackground = GetStockObject( %BLACK_BRUSH )
  wndclass.lpszMenuName  = %NULL
  wndclass.lpszClassName = VARPTR( szAppName )
  wndclass.hIconSm       = LoadIcon( hInstance, BYVAL %IDI_APPLICATION )

  RegisterClassEx wndclass

  ' Create a window using the registered class
  hWnd = CreateWindow("GDIWINDOW", _             ' window class name
                      "PowerBASIC GDI Test", _   ' window caption
                      %WS_OVERLAPPEDWINDOW, _    ' window style
                      %CW_USEDEFAULT, _          ' initial x position
                      %CW_USEDEFAULT, _          ' initial y position
                      %CW_USEDEFAULT, _          ' initial x size
                      %CW_USEDEFAULT, _          ' initial y size
                      %NULL, _                   ' parent window handle
                      %NULL, _                   ' window menu handle
                      hInstance, _               ' program instance handle
                      BYVAL %NULL)               ' creation parameters

  ShowWindow hWnd, iCmdShow
  UpdateWindow hWnd

  WHILE GetMessage(Msg, %NULL, 0, 0)
    TranslateMessage Msg
    DispatchMessage Msg
  WEND

  FUNCTION = msg.wParam

END FUNCTION  ' WinMain

'------------------------------------------------------------------------------

FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                  BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG

  LOCAL hDC       AS LONG
  LOCAL LpPaint   AS PaintStruct
  LOCAL tRect     AS Rect

  STATIC First    AS LONG

  SELECT CASE wMsg

    CASE %WM_CREATE

    CASE %WM_LBUTTONDOWN
      InvalidateRect hWnd, BYVAL %NULL, %TRUE

    CASE %WM_ERASEBKGND
      IF First = 0 THEN
        First = 1
      ELSE
        FUNCTION = 1
        EXIT FUNCTION
      END IF

    CASE %WM_KEYDOWN
      InvalidateRect hWnd, BYVAL %NULL, %TRUE

    CASE %WM_PAINT
      PRINT "Plotting.....";
      Plot hWnd
      PRINT "Press a key"
      FUNCTION = 0
      EXIT FUNCTION

    CASE %WM_DESTROY
      PostQuitMessage 0
      FUNCTION = 0
      EXIT FUNCTION

  END SELECT

  FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION