多角形の描画

GDIを利用した多角形描画。

#include "gdi32.as"
    cls 4

    CreatePen 0, 3, 0xffff00
    if stat {
        hPen = stat
    } else {
        end
    }

    CreateSolidBrush 0xff0000
    if stat {
        hBrush = stat
    } else {
        end
    }

    points = 50, 50, 150, 100, 100, 150
    SelectObject hDC, hPen
    SelectObject hDC, hBrush
    Polygon hDC, varptr(points), 3
    DeleteObject hPen
    DeleteObject hBrush
    redraw 1
    stop

リサージュ曲線を描画する

リサージュ曲線を描画するスクリプト。

#const RADIUS 200
#const PI     3.14159
    a = 3
    b = 2
    posCenterX = double(RADIUS + 50)
    posCenterY = double(RADIUS + 50)
    screen 0, posCenterX * 2, posCenterY * 2
    i = 0.0
    pos posCenterX + RADIUS, posCenterY
    while i <= PI * 2
        line posCenterX + cos(i * a) * RADIUS, posCenterY - sin(i * b) * RADIUS
        i += 0.01
        ; await 1
    wend
    title "finish"
    stop

最大公約数と最大公倍数を求める

// 最大公約数(GCD)と最小公倍数(LCM)を求めるユーザー定義関数

#module GetGCDandLCM
#defcfunc _gcd int high, int low, local tmp
    tmp = high \ low
    if tmp {
        return _gcd(low, tmp)
    } else {
        return low
    }

#defcfunc gcd int i1, int i2
    if i1 > i2 {
        return _gcd(i1, i2)
    } else {
        return _gcd(i2, i1)
    }

#defcfunc lcm int i1, int i2
    return i1 * i2 / gcd(i1, i2)
#global

// 以下サンプル
#runtime "hsp3cl"
    mes "最大公約数と最小公倍数を求める整数を２つ入力してください..."
    repeat 2
        repeat
            input tmp, , 1
            if int(tmp) > 0 : break
            mes "1以上の整数値を入力してください..."
        loop
        num(cnt) = int(tmp)
    loop

    mes "GCD(" + num(0) + ", " + num(1) + ") = " + gcd(num(0), num(1))
    mes "LCM(" + num(0) + ", " + num(1) + ") = " + lcm(num(0), num(1))
    stop

ベジェ曲線

ベジェ曲線を描画する。
2つ目以降のベジェ曲線は、1つ前のベジェ曲線の終点を始点とする。

参考

• http://musashi.or.tv/fontguide_doc3.htm

// 3次のベジェ曲線 for HSP3

#module Bezier
// 3次のベジェ曲線を描画
// (x1, y1)と(x4, y4)が端点、(x2, y2)と(x3, y3)が方向点
#deffunc bzArgo int x1, int y1, int x2, int y2, int x3, int y3, int x4, int y4, local t, local k, local lx, local ly
    pos x1, y1
    repeat 100, 1
        t = double(cnt)/100
        k = 1.0 - t
        lx = k * k * k * x1 + 3.0 * k * k * t * x2 + 3.0 * k * t * t * x3 + t * t * t * x4
        ly = k * k * k * y1 + 3.0 * k * k * t * y2 + 3.0 * k * t * t * y3 + t * t * t * y4
        line lx, ly
    loop
    return

// 制御点を4つづつ区切り、bzArgoに渡す
#deffunc bzDrawLine
    repeat (count - 1)/3
        bzArgo x(cnt*3), y(cnt*3), x(cnt*3 + 1), y(cnt*3 + 1), x(cnt*3 + 2), y(cnt*3 + 2), x(cnt*3 + 3), y(cnt*3 + 3)
    loop
    return

// 点を描画
#deffunc bzDrawPoint
    repeat count
        circle x(cnt) - 2, y(cnt) - 2, x(cnt) + 2, y(cnt) + 2
    loop
    return

// 点を追加
#deffunc bzAdd int x1, int y1
    x(count) = x1 : y(count) = y1
    count++
    return count

#deffunc bzClear
    count = 0
    dim x, 1 : dim y, 1
    cls 4
    return
#global

    bzClear
    onclick *addPoint
    stop

// 左クリックで制御点を追加、右クリックで制御点を削除
*addPoint
    if iparam == 0 {
        bzAdd lparam & $FFFF, lparam >> 16

        redraw 0
        color : boxf
        color 255
        bzDrawPoint
        color 255, 255, 255
        bzDrawLine
        redraw
    } else {
        if iparam == 3 : bzClear
    }
    stop

砲弾の射出（d3module）

目標地点を指定すると、そのために必要な射出方向を計算する。
射出速度は一定なので、遠方を狙うほど早く着弾する。
// ang ... 角度, pos ... 位置（座標）, velo... 速さ
// distance ... 距離, b ... 放物線の第2係数
#include "d3m.hsp"
#module powModule
#defcfunc pow double d1, int i2, local st
    st = 1.0
    repeat i2
        st *= d1
    loop
    return st
#global

#const GRAVITY  1.0                                 // 重力加速度
#const VELOCITY 30.1                                // 射出速度
#const DISTANCE_MAX VELOCITY * VELOCITY / GRAVITY   // 最大飛距離

#const GRID_MAX         8   // グリッドの本数
#const GRID_DISTANCE    100 // グリッドの間隔
#const TARGET_RADIUS    10  // 照準の半径
#const BULLET_RADIUS    8   // 砲弾の半径

    screen 0, 480, 480

    // 射出点の座標
    posCannonX = double(GRID_MAX) * GRID_DISTANCE / 2
    posCannonY = 0.0
    posCannonZ = 0.0

    // 照準の座標
    posTargetX = double(GRID_MAX) * GRID_DISTANCE / 2
    posTargetY = double(GRID_MAX) * GRID_DISTANCE / 2
    posTargetZ = 0.0

    d3setcam GRID_MAX * GRID_DISTANCE / 2, -300, 200, GRID_MAX * GRID_DISTANCE / 2, GRID_MAX * GRID_DISTANCE / 2, 0

*main
    gosub *move
    gosub *draw
    wait 4
    goto *main

*move
    stick key, 15
    if key & 16 : gosub *shot

    // 照準の移動
    posTargetX += 10 * (((key >> 2) & 1) - (key & 1))
    posTargetY += 10 * (((key >> 1) & 1) - ((key >> 3) & 1))

    // 砲弾の移動
    if posBulletZ >= 0 {
        posBulletX += veloBulletX
        posBulletY += veloBulletY
        posBulletZ += veloBulletZ
        veloBulletZ -= GRAVITY
    }
    return

*shot
    // 射出 ここらへんのスクリプトの理解は力学と微分の知識が要ります
    posBulletX = posCannonX
    posBulletY = posCannonY
    posBulletZ = posCannonZ
    angBullet = atan(posTargetY - posCannonY, posTargetX - posCannonX)
    distance = limitf(sqrt(pow(posTargetX - posCannonX, 2) + pow(posTargetY - posCannonY, 2)), 0.0, DISTANCE_MAX)
    b = DISTANCE_MAX / distance + sqrt(pow(DISTANCE_MAX / distance, 2) - 1)

    veloBulletR = sqrt(GRAVITY * distance / b / 2)
    veloBulletZ = b * veloBulletR
    veloBulletX = veloBulletR * cos(angBullet)
    veloBulletY = veloBulletR * sin(angBullet)
    return

*draw
    redraw 0
    color : boxf
    color 0, 255                // グリッド
    repeat GRID_MAX + 1
        d3line cnt * GRID_DISTANCE, 0, 0, cnt * GRID_DISTANCE, GRID_MAX * GRID_DISTANCE, 0
        d3line 0, cnt * GRID_DISTANCE, 0, GRID_MAX * GRID_DISTANCE, cnt * GRID_DISTANCE, 0
    loop

    color 255                   // 照準
    d3circle posTargetX, posTargetY, posTargetZ, TARGET_RADIUS, 0

    if posBulletZ >= 0 {
        color 0, 0, 255         // 砲弾
        d3circle posBulletX, posBulletY, posBulletZ, BULLET_RADIUS
        color 191, 191, 191     // 影
        d3circle posBulletX, posBulletY, 0, BULLET_RADIUS
    }
    redraw 1
    return

素数を任意の個数だけ出力

素数を任意の個数だけ出力するスクリプト。
検索を開始する数値を指定可能。
ちょっぴりフールプルーフ。
#runtime "hsp3cl"
#module
#defcfunc prime int num
    result = 1
    repeat (num + 1)/2 - 1, 2
        if (num \ cnt) == 0 : result = 0 : break
    loop
    return result
#global

    repeat
        mes "素数をいくつ出力しますか？"
        input many, , 1
        if int(many) > 0 : break
        mes "1以上の整数値を入力してください..."
    loop

    repeat
        mes "いくつから調べ始めますか？"
        input start, , 1
        if int(start) > 1 : break
        mes "2以上の整数値を入力してください..."
    loop

    many = int(many)
    mes str(many) + "個の素数を出力します..."
    i = 0
    repeat -1, int(start)
        if prime(cnt) {
            mes cnt
            i++
            if i == many : break
        }
    loop
    mes "終了しました。"
    end

2次のBスプライン関数による曲線

2次のBスプライン関数を描画する。

// 2次のBスプライン関数 for HSP3

#module BSpline
// 2次のBスプライン関数を描画
// (x1, y1)と(x3, y3)がオンカーブ点、(x2, y2)がオフカーブ点
#deffunc bsArgo int x1, int y1, int x2, int y2, int x3, int y3, local k, local t
    pos x1, y1
    repeat 100, 1
        t = double(cnt)/100
        k = 1.0 - t
        line k * k * x1 + 2.0 * t * k * x2 + t * t * x3, k * k * y1 + 2.0 * t * k * y2 + t * t * y3
    loop
    return

// オンカーブ点を算出し、bsArgoへ渡す
#deffunc bsDrawLine local xCurrent, local yCurrent
    if count > 3 {
        bsArgo x(0), y(0), x(1), y(1), (x(1) + x(2))/2, (y(1) + y(2))/2
        xCurrent = (x(1) + x(2))/2 : yCurrent = (y(1) + y(2))/2
        repeat count - 4, 2
            xNext = (x(cnt) + x(cnt + 1))/2 : yNext =  (y(cnt) + y(cnt + 1))/2
            bsArgo xCurrent, yCurrent, x(cnt), y(cnt), xNext, yNext
            xCurrent = xNext : yCurrent = yNext
        loop
        bsArgo xCurrent, yCurrent, x(count - 2), y(count - 2), x(count - 1), y(count - 1)
    } else {
        if count == 3 : bsArgo x(0), y(0), x(1), y(1), x(2), y(2)
    }
    return

// 点を描画
#deffunc bsDrawPoint
    repeat count
        circle x(cnt) - 2, y(cnt) - 2, x(cnt) + 2, y(cnt) + 2
    loop
    return

// 点を追加  最初と最後がオンカーブ点、それ以外はオフカーブ点になる
#deffunc bsAdd int x1, int y1
    x(count) = x1 : y(count) = y1
    count++
    return count

#deffunc bsClear
    count = 0
    dim x, 1 : dim y, 1
    cls 4
    return
#global

    bsClear
    onclick *addPoint
    stop

// 左クリックで制御点を追加、右クリックで制御点を削除
*addPoint
    if iparam == 0 {
        bsAdd lparam & $FFFF, lparam >> 16

        redraw 0
        color : boxf
        color 255
        bsDrawPoint
        color 255, 255, 255
        bsDrawLine
        redraw
    } else {
        if iparam == 3 : bsClear
    }
    stop