FreeBASIC SineWave

' SineWave.bas, by MrSwiss - 2016-08-11/23
'----------------------------------------------------------------------------
' Sets the graphics method GDI
' 描画方法を GDI に設定
SetEnviron("fbgfx=GDI")

#Ifdef __FB_64BIT__               ' FBC 64bit バージョンの場合 !!!
   #If __FB_VERSION__ < "1.05.0"   ' 前処理: バージョンを確認, 
   ' FBC x64 の 1.04.0 までは不具合があります (fbGFX: Line Style)
      #Error FBC-x64-Version 1.05.0 or later required, _
            to compile this Program correctly!
   #EndIf   ' __FB_VERSION__ < "1.05.0"
#EndIf   ' __FB_64BIT__ 

#Include Once "grid.bas" ' Sub Grid() の実装を導入します
' この位置 'in code' での導入は、宣言 や .bi ファイルの必要性を回避します。
' "Declare ..." をしてくれます。
'----------------------------------------------------------------------------
Const As Single   pi = 4.0f * Atn(1.0f), _ ' 'f' = Float = Single (aka: '!')
            d2r = pi / 180.0f

#Define RAD(d)   ( d * d2r )   ' 一行マクロ (角度「度」を「ラジアン」に)
'----------------------------------------------------------------------------
Const As Long   scrw = 801, scrh = 801, cd = 32, _   ' screen stuff, base
            iw = scrw - 1, ih = scrh - 1, _
            iwh = scrw \ 2, ihh = scrh \ 2
'----------------------------------------------------------------------------
Const As Long   Marg = 50, dMarg = Marg * 2         ' screen stuff, extended
Const As Short   LineDef = &b1111100110011111   ' fixed from: FBC 1.05.0 x64
'----------------------------------------------------------------------------
Const As ULong   red = &hFFFF0000, green = &hFF00FF00, _   ' 色
            blue = &hFF007FFF, d_grey = &hFF272727
'----------------------------------------------------------------------------
' === MAIN ===
ScreenRes(scrw, scrh, cd,,, 60)   ' refresh rate: 60 Hz
Width , scrh \ 16            ' フォント・サイズ: 8 x 16 (for Locate and Print)
WindowTitle "SineWave: " & scrw - dMarg & "x" & scrh - dMarg & _
         " | WindowSize: " & scrw & "x" & scrh & " | " & _
         __FB_SIGNATURE__ & " x" & SizeOf(Integer) * 8

Dim As Double   t1, t2, t3, t4 = .00005   ' t4 = 遅延時間 (描画速度を調整して下さい)
' だいたいの実行時間: 1/10,000 ~ 3,6 Sec. | 1/20,000 ~ 1.8 Sec. (現在の設定) など.
Dim As Single   xt, ys, yc, x2tmf = 701 / 360 ' x2tmf = 時間軸の乗数
Dim As Long      hA = (ih - dMarg) \ 2   ' 振幅の半分（中心からの最大オフセット）
Dim As String   ans                  

again:   ' ジャンプ ラベル (私は、昔からの GoTo 文議論を蒸し返したくないです!)
' プログラムを簡単にするためだけに使っています。(プログラムの終了条件で、追加ループ)
Cls

Line (Marg, Marg)-(iw-Marg, ih-Marg), d_grey, BF   ' 視野背景
Grid (iw, ih, 70, 50)                        ' 視野格子 70x70, 境界 50
Line (Marg, ihh)-(iw-Marg, ihh), red,, LineDef      ' 十字線, 横
Line (ihh, Marg)-(ihh, ih-Marg), red,, LineDef      ' 十字線, 縦
Locate  2, 4 : Print "SINE = green " + Chr(179) + _   ' 説明文
               " COSINE = blue -90 Deg. of SINE"
t1 = Timer
For i As Single = 0.0 To 359.99 Step .01' loop max. = 360° - 'step size' (360° = 0°!)
   t2 = Timer                     ' このループは、36,000 回、反復実行します! 
   xt = Marg + i * x2tmf            ' X-Axis is used as: t-Axis (Time-Axis)
   ys = ihh - (Sin( RAD(i) ) * hA)      ' Sine * 振幅の半分（中心から） (ihh)
   yc = ihh - (Cos( RAD(i) ) * hA)      ' CoSine * 振幅の半分（中心から）
   PSet (xt, yc), blue : PSet (xt, ys), green   ' CoSine/Sine の両方の点を描画
   While Timer < t2+t4 : Wend         ' 高速遅延 〜 0.05 mS (上の 't4' 参照)
Next
t3 = Timer-t1

Locate 46, 54
Print Using "Render Time:  #.#####  Sec."; t3 ' 実際の実行時間を表示 (all incl.)
Locate 46, 4
Input "Run again ?  [y/N] + [Enter] ", ans   ' ユーザ入力を受け取る。再処理かプログラム終了を判断
If LCase(ans) = "y" Then GoTo again
' --- EOF ---

#Ifdef __FB_64BIT__               ' FBC 64bit バージョンの場合 !!
   #If __FB_VERSION__ < "1.05.0"   ' 前処理: バージョンを確認 -
   ' FBC x64 の 1.00.0 から 1.04.0 までは不具合があります (fbGFX: Line Style)
      #Error FBC-x64-Version 1.05.0 or later required,_
            to compile this Program, at all!
   #EndIf   ' __FB_VERSION__ < "1.05.0"
#EndIf   ' __FB_64BIT__


' Sub Grid(), by Mr Swiss, 2016-08-21/23 -- 'このまま', ご自身の責任で使って下さい !!
' ---------------------------------------------------------------------------
' このルーチンは、内側の 縦/横の終了点/画素は「偶数」で、
' 画面サイズは、「奇数」、という仮定に基づいています。
' （現実/物理的に中心画素が必要です）！
' そうでないと、得られた正方形は同じサイズではありません（仕上げ/閉鎖線が欠落）
' ---------------------------------------------------------------------------
' 注意：パラメータの 1 - 4 で、負数エラーチェックはしていません。(速度！)
' また：'hvb' パラメータ(5番目)以外は、範囲をチェックしません。換言: 貴方の責任!
' ---------------------------------------------------------------------------
Sub Grid  (   ByVal hf As Long, ByVal vf As Long, _   ' 横/縦 最終点
         ByVal ds As Long, ByVal br As Long=0, _      ' 距離, 境界
         ByVal hvb As Byte=3, _                       ' 横, 縦, 両方
         ByVal clr As ULong=&hFF7F7F7F, _             ' 色: 32bit '灰色'
         ByVal ln_st As UShort=&hFFFF )               ' 線様式 '実線'
   Select Case As Const hvb   ' モード選択
      Case 1      ' 横線のみ
         Var trm = (vf - br Shl 1) \ ds
         For i As Integer = 0 To trm
            Var pp = i * ds + br
            Line (br, pp)-(hf-br, pp), clr,, ln_st
         Next
      Case 2      ' 縦線のみ
         Var trm = (hf - br Shl 1) \ ds
         For i As Integer = 0 To trm
            Var pp = i * ds + br
            Line (pp, br)-(pp, vf-br), clr,, ln_st
         Next
      Case 3      ' 縦横両方 = 既定 = 正方格子
         Var trm = (vf - br Shl 1) \ ds
         For i As Integer = 0 To trm
            Var pp = i * ds + br
            Line (br, pp)-(hf-br, pp), clr,, ln_st
         Next
         trm = (hf - br Shl 1) \ ds   ' var reuse (in same 'scope' only!)
         For i As Integer = 0 To trm
            Var pp = i * ds + br
            Line (pp, br)-(pp, vf-br), clr,, ln_st
         Next
      Case Else
         Print "ERROR: Grid() param. 5, out of range!"
   End Select
End Sub
' --- End Proc. ---