Subversion Repositories Kolibri OS

; 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

   ;=============================================================