; KolSPForth v12
SYSTEM equ EMUL
;Memory Map
;
;0
;0x02C7D ;I_END
;0x05430 ;CTOP
;0x3F800 ;Data stack
;0x3FA00 ;return stack
;0x3FC00 ;User
;0x3FE00 ;TIB
;0x30000 ;FILE BUFF
;0x40000 (256K)
;; Version control
VER EQU 1 ;major release version
EXT EQU 0 ;minor extension
;; Constants
TRUEE EQU -1 ;true flag
COMPO EQU 040H ;lexicon compile only bit
IMEDD EQU 080H ;lexicon immediate bit
MASKK EQU 01FH ;lexicon bit mask
CELLL EQU 4 ;size of a cell
BASEE EQU 10 ;default radix
VOCSS EQU 8 ;depth of vocabulary stack
BKSPP EQU 8 ;back space
LF EQU 10 ;line feed
CRR EQU 13 ;carriage return
ERR EQU 27 ;error escape
TIC EQU 39 ;tick
CALLL EQU 0E8H ;CALL opcodes
ROWH EQU 13
KEY_DELAY EQU 20
FW_WIDTH equ 500
FW_HEIGHT equ 352
;; Memory allocation
EM EQU 256*1024 ;top of memory
FILE_BS EQU 64*1024 ;file buff size
US EQU 128*CELLL ;user area size in cells
RTS EQU 1024*CELLL ;return stack/TIB size
FILE_B EQU EM-FILE_BS ;terminal input buffer (TIB)
TIBB EQU FILE_B-RTS ;terminal input buffer (TIB)
; UPP EQU TIBB-US ;start of user area (UP0)
RPP EQU UPP-RTS ;start of return stack (ESP0)
SPP EQU RPP-RTS ;start of data stack (EBP0)
LastNFA = 0
LastCFA EQU INIT
macro AHEADER FLAG,ID,F_CFA {
db FLAG
DD F_CFA
DD LastNFA
The_Nfa = $
DB ID,0
LastNFA = The_Nfa
F_CFA:
}
macro cfa_AHEADER FLAG,ID,F_CFA {
db FLAG
DD cfa_#F_CFA
DD LastNFA
The_Nfa = $
DB ID,0
LastNFA = The_Nfa
cfa_#F_CFA:
}
;; Main entry points and COLD start data
use32
format binary as ""
org 0x0
db 'MENUET01'
dd 0x01
dd ORIG ; start of code
dd I_END ; size of image
MEMS: dd EM ; memory for app
dd SPP ; esp
if SYSTEM eq MEOS
dd FINFO.path
else
dd 0
end if
dd 0x0 ; I_Param , I_Icon
lang fix ru
include 'MACROS.INC'
include '..\..\proc32.inc'
align 4
proc strncmp stdcall, s1:dword, s2:dword, n:dword
push esi
push edi
mov ecx, [n]
test ecx, ecx ; Max length is zero?
je .done
mov esi, [s1] ; esi = string s1
mov edi, [s2] ; edi = string s2
cld
.compare:
cmpsb ; Compare two bytes
jne .done
cmp byte [esi-1], 0 ; End of string?
je .done
dec ecx ; Length limit reached?
jne .compare
.done:
seta al ; al = (s1 > s2)
setb ah ; ah = (s1 < s2)
sub al, ah
movsx eax, al ; eax = (s1 > s2) - (s1 < s2), i.e. -1, 0, 1
pop edi
pop esi
ret
endp
align 4
proc GetPr stdcall, exp:dword, sz_name:dword
mov edx, [exp]
.next:
push edx
stdcall strncmp, edx, [sz_name], 16
pop edx
test eax, eax
jz .ok
mov edx, [edx-4]
test edx, edx
jnz .next
mov eax,edx
ret
.ok:
mov eax, [edx-8]
ret
endp
AHEADER 0 ,'GETPR',cfa_GETPR
JMP GetPr
ORIG:
MOV EBP,RPP ;initialize RP
CLD ;ESI gets incremented
finit
call draw_window
call calc_lines
XCHG ESP,EBP
CALL amain
BYE: mcall -1
ULAST: ; DD 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
draw_cursor:
draw_window:
pusha
mcall 12,1
mov [fRed],ebx
mcall 0, <0,FW_WIDTH>, <0,FW_HEIGHT>, 0x54000000
; mcall 0,,,COL_WINDOW_BG, ,title ; define window
mcall 71, 1, header
mcall 9,pinfo,-1
mov eax,[pinfo.x_size]
cdq
sub eax,20
mov ebx,6
div ebx
mov [pinfo.x_start],eax
mov eax,[pinfo.y_size]
cdq
sub eax,40
mov ebx,ROWH
div ebx
mov [pinfo.y_start],eax
call erase_screen
mcall 12, 2
mcall 67,-1,-1,FW_WIDTH,FW_HEIGHT
popa
ret
macro GetSkinHeight
{
mov eax,48
mov ebx,4
int 0x40
}
erase_screen:
GetSkinHeight
mov ecx,eax
shl ecx,16
add ecx,[pinfo.y_size]
sub ecx,eax
sub ecx,4
mov ebx,[pinfo.x_size]
add ebx,5 shl 16 - 9
mcall 13,,,0;xff
ret
AHEADER 0,"CC_LINES",cfa_CC_LINES
calc_lines:
cmp dword[UPP+10*4],0
je .ex
pusha
mov ebp,os_work
mov al,0xd
mov edi,screen_buf
; mov esi,[cursor]
; mov byte[esi],'_'
; inc [cursor]
.again:
mov [ebp],edi
mov esi,[cursor]
sub esi,edi
mov ecx,[pinfo.x_start]
; test ecx,ecx
; jnz .no0
; inc ecx
; .no0:
cmp ecx,esi
jbe .ok
mov ecx,esi
.ok:
repne scasb
jecxz .nocrlf
cmp byte[edi],10
jne .nocrlf
inc edi
.nocrlf:
mov ecx,edi
sub ecx,[ebp]
add ebp,8
mov [ebp-4],ecx
cmp edi,[cursor]
jb .again
and dword[ebp],0
; dpd esi
mov eax,[pinfo.y_start]
shl eax,3
sub ebp,eax
cmp ebp,os_work
jae .ok2
mov ebp,os_work
.ok2:
cmp ebp,[last_ebp]
je .ok3
mov [last_ebp],ebp
call erase_screen
.ok3:
mov ebx,10 shl 16 +30
; ud2
.newl:
mcall 4,,0xffffff,[ebp],[ebp+4]
add ebp,8
add ebx,ROWH
cmp dword[ebp],0
jnz .newl
SUB ebx,ROWH
call set_cur
popa
.ex:
ret
set_cur:
MOV ecx,EBX
shl ecx,16
add ecx,EBX
MOV EAX,[ebp+4-8]
add EAX,2
imul EAX,6
mov EBX,EAX
shl ebx,16
add EBX,EAX
mov [lastcur],ecx
mov [lastcur+4],ebx
ret
e_calc_lines:
cmp dword[UPP+10*4],0
je e_.ex
pusha
mov ebp,os_work
mov al,0xd
mov edi,screen_buf
; mov esi,[cursor]
; mov byte[esi],'_'
; inc [cursor]
e_.again:
mov [ebp],edi
mov esi,[cursor]
sub esi,edi
mov ecx,[pinfo.x_start]
; test ecx,ecx
; jnz .no0
; inc ecx
; .no0:
cmp ecx,esi
jbe e_.ok
mov ecx,esi
e_.ok:
repne scasb
jecxz e_.nocrlf
cmp byte[edi],10
jne e_.nocrlf
inc edi
e_.nocrlf:
mov ecx,edi
sub ecx,[ebp]
add ebp,8
mov [ebp-4],ecx
cmp edi,[cursor]
jb e_.again
and dword[ebp],0
; dpd esi
mov eax,[pinfo.y_start]
shl eax,3
sub ebp,eax
cmp ebp,os_work
jae e_.ok2
mov ebp,os_work
e_.ok2:
cmp ebp,[last_ebp]
je e_.ok3
mov [last_ebp],ebp
cmp byte[edi],10
jne e_.ok3
call erase_screen
e_.ok3:
mov ebx,10 shl 16+30
; ud2
e_.newl:
; mcall 4,,0xffffff,[ebp],[ebp+4]
add ebp,8
add ebx,ROWH
cmp dword[ebp],0
jnz e_.newl
SUB ebx,ROWH
mcall 4,,0x00ffffff,[ebp-8],[ebp+4-8]
call set_cur
popa
e_.ex:
ret
AHEADER 0,"?KEY",cfa_queKEY
PUSH EDI
XCHG EBP,ESP
PUSH EAX
POP EBX
mov eax,10
test ebx,ebx
jz QRX0
inc eax
QRX0:
XOR ECX,ECX ;EBX=0 setup for false flag
mcall
cmp eax,1
jne QRX_
call draw_window
call calc_lines
QRX_:
cmp eax,3
je BYE
cmp eax,2
jne QRX3
mcall 2
QRX1: MOVZX ECX,AH
QRX2: PUSH ECX ;save character
QRX_TRUE:
MOV ECX,TRUEE ;true flag
QRX3: PUSH ECX
POP eax
XCHG EBP,ESP
POP EDI
ret
; ?RX ( -- c T | F )
; Return input character and true, or a false if no input.
AHEADER 0,"EMIT_N",cfa_EMIT_N
PUSH EDI
XCHG EBP,ESP
;char in AL
CMP AL,0FFH ;0FFH is interpreted as input
JNZ TX2 ;do NOT allow input
MOV AL,32 ;change to blank
TX2:
mov ebx,[cursor]
mov [ebx],AL
inc [cursor]
POP eax
XCHG EBP,ESP
POP EDI
RET
;; Basic I/O
cfa_AHEADER 0,'CL_CUR',CL_CUR
PUSH EAX
mcall 38,[lastcur+4],[lastcur],0
POP EAX
RET
cfa_AHEADER 0,'DR_CUR',DR_CUR
PUSH EAX
mcall 38,[lastcur+4],[lastcur],0x00FF00FF
POP EAX
RET
COLOR_ORDER equ MENUETOS
include 'gif_lite.inc'
cfa_AHEADER 0,'READ_GIF',READ_GIF ;( gif_ptr, out_ptr -- result )
push esi
push edi
push ebp
mov edi, eax
mov esi,[ebp]
mov eax,os_work
call ReadGIF
pop ebp
pop edi
pop esi
add ebp,4
RET
;===============================================================
cursor dd screen_buf
fRed dd 1
last_ebp dd 0
include 'amain.asm'
header db 'Kolibri Forth v12.1',0
FINFO:
.mode dd 0
dd 0
.blk dd 1
.buf dd 0
.work dd os_work
.path:
db '/RD/1/AUTOLOAD.F'
; db '/RD/1/EXAMPLE.F'
; db '/RD/1/PICTURE.F'
db 0
.end_path:
rb 256-($-.path)
lastcur dd 0,0
I_END:
squote_buf rb 1024
sys_v rd 6
screen_buf:
; sc_end:
rb 4096
pinfo process_information
os_work rb 16*1024
CTOP = $ ;next available memory in code dictionary
;=============================================================