Skip to content

Instantly share code, notes, and snippets.

@fu-sen
Last active April 19, 2025 02:12
Show Gist options
  • Save fu-sen/03ba9c1c160d9d00a15eb0a1c0682d41 to your computer and use it in GitHub Desktop.
Save fu-sen/03ba9c1c160d9d00a15eb0a1c0682d41 to your computer and use it in GitHub Desktop.
箱入り娘 (Klotski) - SHARP POCKET COMPUTER PC-G815 BASIC https://poke-com.jimdofree.com/basic-%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%A0/
1 ' Calendar | SHARP POCKET COMPUTER PC-G815 BASIC
2 ' Copyright (c) 2025 BALLOON | FU-SEN
3 ' The MIT License (MIT) - https://mit.balloon.net.eu.org/#2025
100 CLS :RESTORE :DIM P(19):PX=1:PY=4:C=0
110 LINE (56,0)-(87,31),S,BF
120 LINE (59,0)-(84,30),R,BF
130 LINE (66,31)-(77,31),R
140 FOR I=0 TO 19:READ P(I)
150 Y=INT(I/4):X=I-Y*4
160 BL=P(I):GOSUB 520:NEXT I
170 GOSUB 500:MX=PX:MY=PY
180 I$= INKEY$
190 IF I$="8" OR I$= CHR$ (4) LET MY=PY-1
200 IF I$="2" OR I$= CHR$ (5) LET MY=PY+1
210 IF I$="6" OR I$= CHR$ (14) LET MX=PX+1
220 IF I$="4" OR I$= CHR$ (15) LET MX=PX-1
230 IF I$<>" " AND I$<> CHR$ (13) GOTO 270
240 IF INKEY$ <>"" GOTO 240
250 IF P(PX+PY*4)=16 GOTO 270
260 GOSUB 500:C=1-C:GOTO 170
270 IF MX=PX AND MY=PY GOTO 180
280 IF INKEY$ <>"" GOTO 280
290 IF MX<0 OR MX>3 LET MX=PX:GOTO 180
300 IF MY<0 OR MY>4 LET MY=PY:GOTO 180
310 GOSUB 500
320 IF C=0 LET PX=MX:PY=MY:GOTO 170
330 P=P(PX+PY*4):A= INT (P/4):B=P-A*4
340 AY= INT (A/2):AX=A-AY*2
350 BY= INT (B/2):BX=B-BY*2
360 FOR YY=0 TO AY:FOR XX=0 TO AX
370 P(PX-BX+XX+(PY-BY+YY)*4)=16
380 X=PX-BX+XX:Y=PY-BY+YY
390 BL=16:GOSUB 520:NEXT XX:NEXT YY
400 CH=1:FOR YY=0 TO AY:FOR XX=0 TO AX
410 IF MX-BX+XX+(MY-BY+YY)*4<0 OR MX-BX+XX+(MY-BY+YY)*4>19 LET CH=0:GOTO 430
420 IF P(MX-BX+XX+(MY-BY+YY)*4)<16 LET CH=0
430 NEXT XX:NEXT YY
440 IF CH=1 LET PX=MX:PY=MY
450 FOR YY=0 TO AY:FOR XX=0 TO AX
460 P(PX-BX+XX+(PY-BY+YY)*4)=P+XX-BX+(YY-BY)*2
470 X=PX-BX+XX:Y=PY-BY+YY
480 BL=P+XX-BX+(YY-BY)*2:GOSUB 520:NEXT XX:NEXT YY
490 IF P(13)<>12 GOTO 170 ELSE END
500 IF C=1 LINE (PX*6+60,PY*6)-(PX*6+65,PY*6+5),X,BF:RETURN
510 LINE (PX*6+62,PY*6+2)-(PX*6+63,PY*6+3),X,BF:RETURN
520 LINE (X*6+60,Y*6)-(X*6+65,Y*6+5),R,B
530 IF BL=0 LINE (X*6+61,Y*6+1)-(X*6+64,Y*6+4),S,BF:RETURN
540 IF BL=4 LINE (X*6+61,Y*6+1)-(X*6+65,Y*6+4),S,BF:RETURN
550 IF BL=5 LINE (X*6+60,Y*6+1)-(X*6+64,Y*6+4),S,BF:RETURN
560 IF BL=8 LINE (X*6+61,Y*6+1)-(X*6+64,Y*6+5),S,BF:RETURN
570 IF BL=10 LINE (X*6+61,Y*6 )-(X*6+64,Y*6+4),S,BF:RETURN
580 IF BL=12 LINE (X*6+61,Y*6+1)-(X*6+65,Y*6+5),S,BF:RETURN
590 IF BL=13 LINE (X*6+60,Y*6+1)-(X*6+64,Y*6+5),S,BF:RETURN
600 IF BL=14 LINE (X*6+61,Y*6 )-(X*6+65,Y*6+4),S,BF:RETURN
610 IF BL=15 LINE (X*6+60,Y*6 )-(X*6+64,Y*6+4),S,BF:RETURN
620 LINE (X*6+61,Y*6+1)-(X*6+64,Y*6+4),R,BF:RETURN
630 DATA 8,12,13, 8
640 DATA 10,14,15,10
650 DATA 8, 4, 5, 8
660 DATA 10, 0, 0,10
670 DATA 0,16,16, 0
@fu-sen
Copy link
Author

fu-sen commented Feb 15, 2025

スクリーンショット 2025-02-15 14 17 17

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment