A86: Re: GFM Source (fwd)

A86: Re: GFM Source (fwd)

• To: Assembly-86 <assembly-86@lists.ticalc.org>
• Subject: A86: Re: GFM Source (fwd)
• From: Dan Eble <eble@cis.ohio-state.edu>
• Date: Fri, 12 Sep 1997 13:27:33 -0400 (EDT)
• Reply-To: assembly-86@lists.ticalc.org

In answer to TGaArdvark's request (which he mailed me twice in 5 minutes),
here's the GFM source code.  I have ported it to the 86 myself. The I/O
isn't as nice as it was on the 85, but I will enhance it in the future.

Letters:     [ALPHA]<letter> and [2nd][ALPHA]<letter>
Subscripts:  <number>
Parentheses: [(] or [)]
Calculate:   [ENTER]
Quit:        [EXIT]

The answer is displayed without a decimal point, so the GFM for sulfuric
acid (H2S04) displays as 9808, not 98.08.

The limit on GFM is 655.35.  If a molecule is too big, the program will
display "TooBig".

In the future, I will change it so it uses floating-point math and
displays nicely.  I also hope to make use of built-in input routines to
make the program smaller.  Until then, live with this.

--------
Dan Eble (mailto:eble@cis.ohio-state.edu)
         (http://www.cis.ohio-state.edu/~eble)

---------- Forwarded message ----------
Date: Thu, 11 Sep 1997 22:55:22 -0400 (EDT)
From: TGaArdvark@aol.com
To: eble@ticalc.org
Subject: Re: Source

Could you send me the source for GFM. I need it proted to the 86 fast (like
yesterday), and are willing to do it. I'll send a copy when I'm done, but
will not distribute it without prior permission. Thanks.

#INCLUDE "ti86asm.inc"



;-------------------------------------------------------------------------

; Program Data 

;-------------------------------------------------------------------------



NameLength      .equ PROGEND+00h

InputStr        .equ PROGEND+01h

StringPlace     .equ PROGEND+11h

CursorType      .equ PROGEND+18h

ElemStr         .equ PROGEND+19h

Parenthesis     .equ PROGEND+2Bh

TotalGFM        .equ PROGEND+2Ch

PrevGFM         .equ PROGEND+2Eh

Overflow        .equ PROGEND+30h

; .equ PROGEND+31h





;-------------------------------------------------------------------------

; PROGRAM BEGINS HERE

;-------------------------------------------------------------------------



.org _asm_exec_ram



        call _clrLCD



	res 1,(IY+$D)	; don't alter text memory



PreGetSym:

	set 3,(IY+5)	; display white on black

	ld hl, $0000

        ld (_curRow), hl

	ld (TotalGFM), hl

	ld (PrevGFM), hl

        ld hl, TitleStr         ; title

        call _puts

	res 3,(IY+5)	; display black on white



	ld a, 7		; set cursor for input loop

        ld (_curRow), a

	sub a

	ld (NameLength), a

	ld (Overflow), a



	ld a, '('

	ld (Parenthesis), a



        ld a, 223       ; block cursor

	ld (CursorType), a

        call _putc



GetSymLoop:

        call _getkey

        cp kExit        ; EXIT : program done

	ret z

        cp kEnter       ; Enter : input done

        jp z,K_Enter

        cp kLeft        ; Left : backspace

        jp z,K_Left

        cp kLParen      ; if key < '(', don't bother with it

	jr c, GetSymLoop

        cp kz+1         ; if key > 'z', don't bother with it

        jr nc, GetSymLoop

        ld hl, AlphaTable-kLParen

        add a,l         ; look up char in table

        ld l,a

        adc a,h

        sub l

        ld h,a

        ld a, (hl)      ; a = char or 0

        or a            ; save one byte over "cp 0"

	jr z, GetSymLoop

	push af	

	ld a, (NameLength)

        ld (_curCol), a

        ld d,0          ; de = namelength

        ld e,a

	inc a

        cp 15           ; MaxNameLength

	jr nc, NameTooLong

	ld (NameLength), a

	ld hl, InputStr

	add hl, de

	pop af

	push af

	cp '('

	jr nz, NotParenth

	pop af

	ld a, (Parenthesis)

	xor 1

	ld (Parenthesis), a

	xor 1

	push af

NotParenth:

        ld a, 223       ; block cursor

	ld (CursorType), a

	pop af



	ld (hl),a

        call _putc

        ld a, (_curCol)

	push af

	ld a, (CursorType)

        call _putc

	pop af

        ld (_curCol), a

        jp GetSymLoop

NameTooLong:

	pop af

        jp GetSymLoop



K_Left:

	ld a, (NameLength)

        or a            ; save one byte over "cp 0"

        jp z,GetSymLoop

	dec a

	ld (NameLength), a

	ld e, a

	ld d, 0

	push de

        ld (_curCol), a

	ld a, (CursorType)

        call _putc

        ld a, ' '

        call _putc

	pop de

	ld hl, InputStr

	add hl, de

	ld a, (hl)

	and 11111110b

	cp '('

	jr nz, LeftDone

	ld a, (hl)

	ld (Parenthesis), a

LeftDone:

        jp GetSymLoop



K_Enter:

	ld a, (NameLength)

        or a            ; save one byte over "cp 0"

        jp z,GetSymLoop

	push af

        ld (_curCol), a

	ld a, ' '

        call _putc

	pop af

	ld hl, InputStr

	push hl

	ld d, 0

	ld e, a

	add hl, de

	ld (hl), ')'

	inc hl

	ld (hl), ')'

	pop hl		; hl -> InputStr

        call CalcGFM

        ld a, 16

        ld (_curCol), a

	ld a, (Overflow)

        or a            ; save one byte over "cp 0"

	jr z, NoOverflow

        ld a,15

        ld (_curCol),a

        ld hl, TooBig

        call _puts

        jp PreGetSym

NoOverflow:

	ld hl, (TotalGFM)

        sub a

        call $4A33      ; display AHL as decimal number

        jp PreGetSym



;-------------------------------------------------------------------------

; String Data

;-------------------------------------------------------------------------



TooBig: .db "TooBig", 0



;-------------------------------------------------------------------------

; Calculate GFM of ')'-terminated string

;-------------------------------------------------------------------------



CalcGFM:

	push hl

	ld hl, $2020	; two spaces

	ld (ElemStr), hl

	pop hl

	ld a, (hl)

	inc hl

	cp ')'

	ret z

	cp '('

	jr z, RecurseCalc

	cp 128

	jr nc, Subscript

	cp 'A'			; proceed if A...Z

	jr c, CalcGFM

	cp 'Z'+1

	jr nc, CalcGFM

	ld (ElemStr), a

	ld a, (hl)

	cp 'a'			; if not a...z, start calculation

	jr c, StartCalc

	cp 'z'+1

	jr nc, StartCalc

	ld (ElemStr+1), a

	inc hl

StartCalc:

	push hl



; -- get atomic mass in DE



        ld hl, Elements

	ld b, 92	; number of elements

CmpSymLoop:

	ld a, (ElemStr)

	cp (hl)

	inc hl

	jr nz, ThisNoMatch

FirstMatch:

	ld a, (ElemStr+1)

	cp (hl)

	jr z, BothMatch

ThisNoMatch:

	inc hl

	inc hl

	inc hl

	djnz CmpSymLoop

	ld de, 0	; no match

	jr FindDone



BothMatch:

	inc hl		; hl -> atomic weight

	ld e, (hl)	; de = atomic weight

	inc hl

	ld d, (hl)



FindDone:



; -- end of get atomic mass



	ld (PrevGFM), de

StorePrevGFM:

	ld hl, (TotalGFM)

StoreTotalGFM:

	add hl, de

        jp nc,NoOverflow1

	ld a, 1

	ld (Overflow), a

NoOverflow1:

	ld (TotalGFM), hl

	pop hl

	jr CalcGFM



RecurseCalc:

	ld de, (TotalGFM)

	push de

	ld de, 0

	ld (TotalGFM), de

        call CalcGFM

        pop de          ; de = old total

	push hl

	ld hl, (TotalGFM)	; hl = parenthetical total

	ld (PrevGFM), hl

	jr StoreTotalGFM



Subscript:

	sub 128

Subsub:

	ld b, a

	ld a, (hl)

	sub 128

	jr c, EndofSub

	inc hl

	push af

	sla b

	ld a, b

	rlca

	rlca

	add a, b

	pop bc

	add a, b

	jr Subsub

EndofSub:

	ld a, 1

	cp b

        jp nc,CalcGFM   ; if subscript <= 1, go back

	dec b

	ld de, (PrevGFM)

	push hl

	ld hl, 0

MultiplyLoop:

	add hl, de

        jp nc,NoOverflow2

	ld a, 1

	ld (Overflow), a

NoOverflow2:

	djnz MultiplyLoop

	ex de, hl

	jr StorePrevGFM



;-------------------------------------------------------------------------

; Strings

;-------------------------------------------------------------------------



TitleStr: .db " GFM Calculator v1.3 "

          .db " Copr. 1997 Dan Eble ", 0



;-------------------------------------------------------------------------

; Scancode to ASCII translation table

;-------------------------------------------------------------------------



AlphaTable:

; ASCII         ; Scancode : Keysym

.db "("         ; 11h      : kLParen

.db "("         ; 12h      : kRParen

.db 0

.db 0

.db 0

.db 0

.db 0

.db 0

.db 0

.db 0

.db 0

.db 128         ; 1Ch      : k0         ; subscripts

.db 129         ; 1Dh      : k1

.db 130         ; 1Eh      : k2

.db 131         ; 1Fh      : k3

.db 132         ; 20h      : k4

.db 133         ; 21h      : k5

.db 134         ; 22h      : k6

.db 135         ; 23h      : k7

.db 136         ; 24h      : k8

.db 137         ; 25h      : k9

.db 0

.db 0

.db "A"         ; 28h      : kCapA

.db "B"         ; 29h      : kCapB

.db "C"         ; 2Ah      : kCapC

.db "D"         ; 2Bh      : kCapD

.db "E"         ; 2Ch      : kCapE

.db "F"         ; 2Dh      : kCapF

.db "G"         ; 2Eh      : kCapG

.db "H"         ; 2Fh      : kCapH

.db "I"         ; 30h      : kCapI

.db "J"         ; 31h      : kCapJ

.db "K"         ; 32h      : kCapK

.db "L"         ; 33h      : kCapL

.db "M"         ; 34h      : kCapM

.db "N"         ; 35h      : kCapN

.db "O"         ; 36h      : kCapO

.db "P"         ; 37h      : kCapP

.db "Q"         ; 38h      : kCapQ

.db "R"         ; 39h      : kCapR

.db "S"         ; 3Ah      : kCapS

.db "T"         ; 3Bh      : kCapT

.db "U"         ; 3Ch      : kCapU

.db "V"         ; 3Dh      : kCapV

.db "W"         ; 3Eh      : kCapW

.db "X"         ; 3Fh      : kCapX

.db "Y"         ; 40h      : kCapY

.db "Z"         ; 41h      : kCapZ

.db "a"         ; 42h      : ka

.db "b"         ; 43h      : kb

.db "c"         ; 44h      : kc

.db "d"         ; 45h      : kd

.db "e"         ; 46h      : ke

.db "f"         ; 47h      : kf

.db "g"         ; 48h      : kg

.db "h"         ; 49h      : kh

.db "i"         ; 4Ah      : ki

.db "j"         ; 4Bh      : kj

.db "k"         ; 4Ch      : kk

.db "l"         ; 4Dh      : kl

.db "m"         ; 4Eh      : km

.db "n"         ; 4Fh      : kn

.db "o"         ; 50h      : ko

.db "p"         ; 51h      : kp

.db "q"         ; 52h      : kq

.db "r"         ; 53h      : kr

.db "s"         ; 54h      : ks

.db "t"         ; 55h      : kt

.db "u"         ; 56h      : ku

.db "v"         ; 57h      : kv

.db "w"         ; 58h      : kw

.db "x"         ; 59h      : kx

.db "y"         ; 5Ah      : ky

.db "z"         ; 5Bh      : kz



;-------------------------------------------------------------------------

; Element Strings

;-------------------------------------------------------------------------



Elements:

.db "H "

.dw 101

.db "He"

.dw 400

.db "Li"

.dw 694

.db "Be"

.dw 901

.db "B "

.dw 1081

.db "C "

.dw 1201

.db "N "

.dw 1401

.db "O "

.dw 1600

.db "F "

.dw 1900

.db "Ne"

.dw 2018

.db "Na"

.dw 2299

.db "Mg"

.dw 2431

.db "Al"

.dw 2698

.db "Si"

.dw 2809

.db "P "

.dw 3097

.db "S "

.dw 3206

.db "Cl"

.dw 3545

.db "Ar"

.dw 3995

.db "K "

.dw 3910

.db "Ca"

.dw 4008

.db "Sc"

.dw 4496

.db "Ti"

.dw 4790

.db "V "

.dw 5094

.db "Cr"

.dw 5200

.db "Mn"

.dw 5494

.db "Fe"

.dw 5584

.db "Co"

.dw 5893

.db "Ni"

.dw 5871

.db "Cu"

.dw 6354

.db "Zn"

.dw 6537

.db "Ga"

.dw 6972

.db "Ge"

.dw 7259

.db "As"

.dw 7492

.db "Se"

.dw 7896

.db "Br"

.dw 7991

.db "Kr"

.dw 8380

.db "Rb"

.dw 8547

.db "Sr"

.dw 8762

.db "Y "

.dw 8891

.db "Zr"

.dw 9122

.db "Nb"

.dw 9291

.db "Mo"

.dw 9594

.db "Tc"

.dw 9800

.db "Ru"

.dw 10107

.db "Rh"

.dw 10291

.db "Pd"

.dw 10645

.db "Ag"

.dw 10787

.db "Cd"

.dw 11240

.db "In"

.dw 11482

.db "Sn"

.dw 11869

.db "Sb"

.dw 12175

.db "Te"

.dw 12760

.db "I "

.dw 12690

.db "Xe"

.dw 13130

.db "Cs"

.dw 13291

.db "Ba"

.dw 13734

.db "La"

.dw 13891

.db "Ce"

.dw 14012

.db "Pr"

.dw 14091

.db "Nd"

.dw 14424

.db "Pm"

.dw 14700

.db "Sm"

.dw 15035

.db "Eu"

.dw 15196

.db "Gd"

.dw 15725

.db "Tb"

.dw 15892

.db "Dy"

.dw 16250

.db "Ho"

.dw 16493

.db "Er"

.dw 16726

.db "Tm"

.dw 16893

.db "Yb"

.dw 17304

.db "Lu"

.dw 17497

.db "Hf"

.dw 17849

.db "Ta"

.dw 18095

.db "W "

.dw 18385

.db "Re"

.dw 18625

.db "Os"

.dw 19025

.db "Ir"

.dw 19225

.db "Pt"

.dw 19509

.db "Au"

.dw 19697

.db "Hg"

.dw 20059

.db "Tl"

.dw 20437

.db "Pb"

.dw 20719

.db "Bi"

.dw 20898

.db "Po"

.dw 21000

.db "At"

.dw 21000

.db "Rn"

.dw 22200

.db "Fr"

.dw 22300

.db "Ra"

.dw 22600

.db "Ac"

.dw 22700

.db "Th"

.dw 23204

.db "Pa"

.dw 23100

.db "U "

.dw 23803



PROGEND: ; There should be nothing after this label



.end

• Prev: Re: A86: Please read this!!! New shell!!! I need help!
• Next: A86: Zilog
• Index(es):
  • Main
  • Thread